--- loncom/interface/londocs.pm 2007/06/16 17:42:24 1.278 +++ loncom/interface/londocs.pm 2017/12/29 15:11:18 1.647 @@ -1,7 +1,7 @@ # The LearningOnline Network # Documents # -# $Id: londocs.pm,v 1.278 2007/06/16 17:42:24 albertel Exp $ +# $Id: londocs.pm,v 1.647 2017/12/29 15:11:18 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -33,15 +33,27 @@ use Apache::Constants qw(:common :http); use Apache::imsexport; use Apache::lonnet; use Apache::loncommon; +use Apache::lonhtmlcommon; use LONCAPA::map(); use Apache::lonratedt(); use Apache::lonxml; use Apache::lonclonecourse; use Apache::lonnavmaps; +use Apache::lonnavdisplay(); +use Apache::lonextresedit(); +use Apache::lontemplate(); +use Apache::lonsimplepage(); +use Apache::lonhomework(); +use Apache::lonpublisher(); +use Apache::lonparmset(); use HTML::Entities; +use HTML::TokeParser; use GDBM_File; +use File::MMagic; +use File::Copy; use Apache::lonlocal; use Cwd; +use UUID::Tiny ':std'; use LONCAPA qw(:DEFAULT :match); my $iconpath; @@ -52,16 +64,11 @@ my $hashtied; my %alreadyseen=(); my $hadchanges; +my $suppchanges; -# Available help topics my %help=(); -# Mapread read maps into LONCAPA::map:: global arrays -# @order and @resources, determines status -# sets @order - pointer to resources in right order -# sets @resources - array with the resources with correct idx -# sub mapread { my ($coursenum,$coursedom,$map)=@_; @@ -71,30 +78,38 @@ sub mapread { } sub storemap { - my ($coursenum,$coursedom,$map)=@_; + my ($coursenum,$coursedom,$map,$contentchg)=@_; + my $report; + if (($contentchg) && ($map =~ /^default/)) { + $report = 1; + } my ($outtext,$errtext)= &LONCAPA::map::storemap('/uploaded/'.$coursedom.'/'.$coursenum.'/'. - $map,1); + $map,1,$report); if ($errtext) { return ($errtext,2); } - - $hadchanges=1; + + if ($map =~ /^default/) { + $hadchanges=1; + } else { + $suppchanges=1; + } return ($errtext,0); } -# ----------------------------------------- Return hash with valid author names + sub authorhosts { my %outhash=(); my $home=0; my $other=0; - foreach (keys %env) { - if ($_=~/^user\.role\.(au|ca)\.(.+)$/) { + foreach my $key (keys(%env)) { + if ($key=~/^user\.role\.(au|ca)\.(.+)$/) { my $role=$1; my $realm=$2; - my ($start,$end)=split(/\./,$env{$_}); + my ($start,$end)=split(/\./,$env{$key}); if (($start) && ($start>time)) { next; } if (($end) && (time>$end)) { next; } - my $ca; my $cd; + my ($ca,$cd); if ($1 eq 'au') { $ca=$env{'user.name'}; $cd=$env{'user.domain'}; @@ -104,816 +119,524 @@ sub authorhosts { my $allowed=0; my $myhome=&Apache::lonnet::homeserver($ca,$cd); my @ids=&Apache::lonnet::current_machine_ids(); - foreach my $id (@ids) { if ($id eq $myhome) { $allowed=1; } } + foreach my $id (@ids) { + if ($id eq $myhome) { + $allowed=1; + last; + } + } if ($allowed) { $home++; - $outhash{'home_'.$ca.'@'.$cd}=1; + $outhash{'home_'.$ca.':'.$cd}=1; } else { - $outhash{'otherhome_'.$ca.'@'.$cd}=$myhome; + $outhash{'otherhome_'.$ca.':'.$cd}=$myhome; $other++; } } } return ($home,$other,%outhash); } -# ------------------------------------------------------ Generate "dump" button -sub dumpbutton { - my ($home,$other,%outhash)=&authorhosts(); - my $type = &Apache::loncommon::course_type(); - if ($home+$other==0) { return ''; } - my $output=''; - if ($home) { - return ''. - ''. - &Apache::loncommon::help_open_topic('Docs_Dump_Course_Docs'); - } else { - return''. - &mt('Dump '.$type. - ' DOCS to Construction Space: available on other servers'); - } -} sub clean { my ($title)=@_; $title=~s/[^\w\/\!\$\%\^\*\-\_\=\+\;\:\,\\\|\`\~]+/\_/gs; - return $title; + return $title; +} + +sub default_folderpath { + my ($coursenum,$coursedom,$navmapref) = @_; + return unless ($coursenum && $coursedom && ref($navmapref)); +# Check if entire course is hidden and/or encrypted + my ($hiddenmap,$encryptmap,$folderpath,$hiddentop); + my $toplevel = "uploaded/$coursedom/$coursenum/default.sequence"; + unless (ref($$navmapref)) { + $$navmapref = Apache::lonnavmaps::navmap->new(); + } + if (ref($$navmapref)) { + if (lc($$navmapref->get_mapparam(undef,$toplevel,"0.hiddenresource")) eq 'yes') { + my $filterFunc = sub { my $res = shift; return (!$res->randomout() && !$res->is_map()) }; + my @resources = $$navmapref->retrieveResources($toplevel,$filterFunc,1,1); + unless (@resources) { + $hiddenmap = 1; + unless ($env{'request.role.adv'}) { + $hiddentop = 1; + if ($env{'form.folder'}) { + undef($env{'form.folder'}); + } + } + } + } + if (lc($$navmapref->get_mapparam(undef,$toplevel,"0.encrypturl")) eq 'yes') { + $encryptmap = 1; + } + } + unless ($hiddentop) { + $folderpath='default&'.&escape(&mt('Main Content')). + '::'.$hiddenmap.':'.$encryptmap.'::'; + } + if (wantarray) { + return ($folderpath,$hiddentop); + } else { + return $folderpath; + } } -# -------------------------------------------------------- Actually dump course sub dumpcourse { my ($r) = @_; - my $type = &Apache::loncommon::course_type(); - $r->print(&Apache::loncommon::start_page('Dump '.$type.' DOCS to Construction Space'). - '
'); - $r->print(&Apache::lonhtmlcommon::breadcrumbs('Dump '.$type.' DOCS to Construction Space')); + my $crstype = &Apache::loncommon::course_type(); + my ($starthash,$js); + unless (($env{'form.authorspace'}) && ($env{'form.authorfolder'}=~/\w/)) { + $js = <<"ENDJS"; + +ENDJS + $starthash = { + add_entries => {'onload' => "hide_searching();"}, + }; + } + $r->print(&Apache::loncommon::start_page('Copy '.$crstype.' Content to Authoring Space',$js,$starthash)."\n". + &Apache::lonhtmlcommon::breadcrumbs('Copy '.$crstype.' Content to Authoring Space')."\n"); + $r->print(&startContentScreen('tools')); my ($home,$other,%outhash)=&authorhosts(); - unless ($home) { return ''; } + unless ($home) { + $r->print(&endContentScreen()); + return ''; + } my $origcrsid=$env{'request.course.id'}; my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid); if (($env{'form.authorspace'}) && ($env{'form.authorfolder'}=~/\w/)) { # Do the dumping - unless ($outhash{'home_'.$env{'form.authorspace'}}) { return ''; } - my ($ca,$cd)=split(/\@/,$env{'form.authorspace'}); + unless ($outhash{'home_'.$env{'form.authorspace'}}) { + $r->print(&endContentScreen()); + return ''; + } + my ($ca,$cd)=split(/\:/,$env{'form.authorspace'}); $r->print('

'.&mt('Copying Files').'

'); my $title=$env{'form.authorfolder'}; $title=&clean($title); - my %replacehash=(); - foreach (keys %env) { - if ($_=~/^form\.namefor\_(.+)/) { - $replacehash{$1}=$env{$_}; - } + my ($navmap,$errormsg) = + &Apache::loncourserespicker::get_navmap_object($crstype,'dumpdocs'); + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my (%maps,%resources,%titles); + if (!ref($navmap)) { + $r->print($errormsg. + &endContentScreen()); + return ''; + } else { + &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles, + 'dumpdocs',$cdom,$cnum); } + my @todump = &Apache::loncommon::get_env_multiple('form.archive'); + my (%tocopy,%replacehash,%lookup,%deps,%display,%result,%depresult,%simpleproblems,%simplepages, + %newcontent,%has_simpleprobs); + foreach my $item (sort {$a <=> $b} (@todump)) { + my $name = $env{'form.namefor_'.$item}; + if ($resources{$item}) { + my ($map,$id,$res) = &Apache::lonnet::decode_symb($resources{$item}); + if ($res =~ m{^uploaded/$cdom/$cnum/\E((?:docs|supplemental)/.+)$}) { + $tocopy{$1} = $name; + $display{$item} = $1; + $lookup{$1} = $item; + } elsif ($res eq 'lib/templates/simpleproblem.problem') { + $simpleproblems{$item} = { + symb => $resources{$item}, + name => $name, + }; + $display{$item} = 'simpleproblem_'.$name; + if ($map =~ m{^\Quploaded/$cdom/$cnum/\E(.+)$}) { + $has_simpleprobs{$1}{$id} = $item; + } + } elsif ($res =~ m{^adm/$match_domain/$match_username/(\d+)/smppg}) { + my $marker = $1; + my $db_name = &Apache::lonsimplepage::get_db_name($res,$marker,$cdom,$cnum); + $simplepages{$item} = { + res => $res, + title => $titles{$item}, + db => $db_name, + marker => $marker, + symb => $resources{$item}, + name => $name, + }; + $display{$item} = '/'.$res; + } + } elsif ($maps{$item}) { + if ($maps{$item} =~ m{^\Quploaded/$cdom/$cnum/\E((?:default|supplemental)_\d+\.(?:sequence|page))$}) { + $tocopy{$1} = $name; + $display{$item} = $1; + $lookup{$1} = $item; + } + } else { + next; + } + } my $crs='/uploaded/'.$env{'request.course.id'}.'/'; $crs=~s/\_/\//g; - foreach (keys %replacehash) { - my $newfilename=$title.'/'.$replacehash{$_}; - $newfilename=~s/\.(\w+)$//; - my $ext=$1; - $newfilename=&clean($newfilename); - $newfilename.='.'.$ext; - my @dirs=split(/\//,$newfilename); - my $path='/home/'.$ca.'/public_html'; - my $makepath=$path; - my $fail=0; - for (my $i=0;$i<$#dirs;$i++) { - $makepath.='/'.$dirs[$i]; - unless (-e $makepath) { - unless(mkdir($makepath,0777)) { $fail=1; } - } - } - $r->print('
'.$_.' => '.$newfilename.': '); - if (my $fh=Apache::File->new('>'.$path.'/'.$newfilename)) { - if ($_=~/\.(sequence|page|html|htm|xml|xhtml)$/) { - print $fh &Apache::lonclonecourse::rewritefile( - &Apache::lonclonecourse::readfile($env{'request.course.id'},$_), - (%replacehash,$crs => '') - ); - } else { - print $fh - &Apache::lonclonecourse::readfile($env{'request.course.id'},$_); - } - $fh->close(); - } else { - $fail=1; - } - if ($fail) { - $r->print('fail'); - } else { - $r->print('ok'); - } - } - } else { -# Input form - unless ($home==1) { - $r->print( - '

'.&mt('Select the Construction Space').'

'); - } else { - $r->print(''); - } - } - } - unless ($home==1) { - $r->print(''); - } - my $title=$origcrsdata{'description'}; - $title=~s/[\/\s]+/\_/gs; - $title=&clean($title); - $r->print('

'.&mt('Folder in Construction Space').'


'); - &tiehash(); - $r->print('

'.&mt('Filenames in Construction Space').'

'); - foreach (&Apache::lonclonecourse::crsdirlist($origcrsid,'userfiles')) { - $r->print(''); - my ($ext)=($_=~/\.(\w+)$/); - my $title=$hash{'title_'.$hash{ - 'ids_/uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'.$_}}; - $r->print(''); - if (!$title) { - $title=$_; - } else { - $title=~s|/|_|g; - } - $title=~s/\.(\w+)$//; - $title=&clean($title); - $title.='.'.$ext; - $r->print("\n\n"); - } - $r->print("
'.&mt('Internal Filename').''.&mt('Title').''.&mt('Save as ...').'
'.$_.''.($title?$title:' ').'
\n"); - &untiehash(); - $r->print( - '

'); - } -} - -# ------------------------------------------------------ Generate "export" button - -sub exportbutton { - my $type = &Apache::loncommon::course_type(); - return ''. - ''. - &Apache::loncommon::help_open_topic('Docs_Export_Course_Docs'); -} - -sub exportcourse { - my $r=shift; - my $type = &Apache::loncommon::course_type(); - my %discussiontime = &Apache::lonnet::dump('discussiontimes', - $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); - my $numdisc = keys %discussiontime; - my $navmap = Apache::lonnavmaps::navmap->new(); - my $it=$navmap->getIterator(undef,undef,undef,1,undef,undef); - my $curRes; - my $outcome; - - &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, - ['finishexport']); - if ($env{'form.finishexport'}) { - &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, - ['archive','discussion']); - - my @exportitems = &Apache::loncommon::get_env_multiple('form.archive'); - my @discussions = &Apache::loncommon::get_env_multiple('form.discussion'); - if (@exportitems == 0 && @discussions == 0) { - $outcome = '
As you did not select any content items or discussions for export, an IMS package has not been created. Please go back to select either content items or discussions for export'; - } else { - my $now = time; - my %symbs; - my $manifestok = 0; - my $imsresources; - my $tempexport; - my $copyresult; - my $ims_manifest = &create_ims_store($now,\$manifestok,\$outcome,\$tempexport); - if ($manifestok) { - &build_package($now,$navmap,\@exportitems,\@discussions,\$outcome,$tempexport,\$copyresult,$ims_manifest); - close($ims_manifest); - -#Create zip file in prtspool - my $imszipfile = '/prtspool/'. - $env{'user.name'}.'_'.$env{'user.domain'}.'_'. - time.'_'.rand(1000000000).'.zip'; - my $cwd = &Cwd::getcwd(); - my $imszip = '/home/httpd/'.$imszipfile; - chdir $tempexport; - open(OUTPUT, "zip -r $imszip * 2> /dev/null |"); - close(OUTPUT); - chdir $cwd; - $outcome .= &mt('Download the zip file from IMS '.lc($type).' archive
',$imszipfile,); - if ($copyresult) { - $outcome .= 'The following errors occurred during export - '.$copyresult; - } - } else { - $outcome = '
Unfortunately you will not be able to retrieve an IMS archive of this posts at this time, because there was a problem creating a manifest file.
'; - } - } - $r->print(&Apache::loncommon::start_page('Export '.lc($type).' to IMS content package')); - $r->print(&Apache::lonhtmlcommon::breadcrumbs('Export '.lc($type).' to IMS content package')); - $r->print($outcome); - $r->print(&Apache::loncommon::end_page()); - } else { - my $display; - $display = '
'."\n"; - $display .= &mt('Choose which items you wish to export from your '.$type.'.

'); - $display .= ''. - ''. - ''. - ''. - '
 Content items'. - ''. - '  
  
 Discussion posts'. - ''. - '  
'; - my $curRes; - my $depth = 0; - my $count = 0; - my $boards = 0; - my $startcount = 5; - my %parent = (); - my %children = (); - my $lastcontainer = $startcount; - my @bgcolors = ('#F6F6F6','#FFFFFF'); - $display .= ''. - ''; - while ($curRes = $it->next()) { - if (ref($curRes)) { - $count ++; - } - if ($curRes == $it->BEGIN_MAP()) { - $depth++; - $parent{$depth} = $lastcontainer; - } - if ($curRes == $it->END_MAP()) { - $depth--; - $lastcontainer = $parent{$depth}; - } - if (ref($curRes)) { - my $symb = $curRes->symb(); - my $ressymb = $symb; - if ($ressymb =~ m|adm/($match_domain)/($match_username)/(\d+)/bulletinboard$|) { - unless ($ressymb =~ m|adm/wrapper/adm|) { - $ressymb = 'bulletin___'.$3.'___adm/wrapper/adm/'.$1.'/'.$2.'/'.$3.'/bulletinboard'; + my $mm = new File::MMagic; + my $prefix = "/uploaded/$cdom/$cnum/"; + %replacehash = %tocopy; + foreach my $item (sort(keys(%simpleproblems))) { + my $content = &Apache::imsexport::simpleproblem($simpleproblems{$item}{'symb'}); + $newcontent{$display{$item}} = $content; + } + my $gateway = Apache::lonhtmlgateway->new('web'); + foreach my $item (sort(keys(%simplepages))) { + if (ref($simplepages{$item}) eq 'HASH') { + my $pagetitle = $simplepages{$item}{'title'}; + my %fields = &Apache::lonnet::dump($simplepages{$item}{'db'},$cdom,$cnum); + my %contents; + foreach my $field (keys(%fields)) { + if ($field =~ /^(?:aaa|bbb|ccc)_(\w+)$/) { + my $name = $1; + my $msg = $fields{$field}; + if ($name eq 'webreferences') { + if ($msg =~ m{^https?://}) { + $contents{$name} = ''.$msg.''; + } + } else { + $msg = &Encode::decode('utf8',$msg); + $msg = $gateway->process_outgoing_html($msg,1); + $contents{$name} = $msg; + } + } elsif ($field eq 'uploaded.photourl') { + my $marker = $simplepages{$item}{marker}; + if ($fields{$field} =~ m{^\Q$prefix\E(simplepage/$marker/.+)$}) { + my $filepath = $1; + my ($relpath,$fname) = ($filepath =~ m{^(.+/)([^/]+)$}); + if ($fname ne '') { + $fname=~s/\.(\w+)$//; + my $ext=$1; + $fname = &clean($fname); + $fname.='.'.$ext; + $contents{image} = 'Image'; + $replacehash{$filepath} = $relpath.$fname; + $deps{$item}{$filepath} = 1; + } + } } } - my $color = $count%2; - $display .=''; - if ($discussiontime{$ressymb} > 0) { - $boards ++; - $currelem = $count+$boards+$startcount; - $display .= ''."\n"; - } else { - $display .= ''."\n"; + if ($contents{webreferences}) { + $content .= ' +
+

'.&mt('Web References').'

'. +$contents{webreferences}.' +
'; } + $content .= ' + + +'; + $newcontent{'/'.$simplepages{$item}{res}} = $content; } } - my $scripttag = qq| - - |; - $r->print(&Apache::loncommon::start_page('Export '.lc($type).' to IMS content package', - $scripttag)); - $r->print(&Apache::lonhtmlcommon::breadcrumbs('Export '.lc($type).' to IMS content package')); - $r->print($display.'
Export content item?
 '."\n"; - if ($numdisc > 0) { - $display.='Export discussion posts?'."\n"; - } - $display.=' 
'."\n". - 'is_sequence()) || ($curRes->is_page())) { - my $checkitem = $count + $boards + $startcount; - $display .= 'onClick="javascript:propagateCheck('."'$checkitem'".')"'; + $replacehash{'/'.$simplepages{$item}{'res'}} = $simplepages{$item}{'name'}; + $lookup{'/'.$simplepages{$item}{'res'}} = $item; + my $content = ' + + +'.$pagetitle.' + +'; + if ($contents{title}) { + $content .= "\n".'

'.$contents{title}.'

'; } - $display .= ' />'."\n"; - for (my $i=0; $i<$depth; $i++) { - $display .= ''."\n"; + if ($contents{image}) { + $content .= "\n".$contents{image}; } - if ($curRes->is_sequence()) { - $display .= ' '."\n"; - $lastcontainer = $count + $startcount + $boards; - } elsif ($curRes->is_page()) { - $display .= ' '."\n"; - $lastcontainer = $count + $startcount + $boards; + if ($contents{content}) { + $content .= ' +
+

'.&mt('Content').'

'. +$contents{content}.' +
'; } - my $currelem = $count+$boards+$startcount; - $children{$parent{$depth}} .= $currelem.':'; - $display .= ' '.$curRes->title().'		   
'. - '

'. - '

'. - &Apache::loncommon::end_page()); - } -} - -sub create_ims_store { - my ($now,$manifestok,$outcome,$tempexport) = @_; - $$tempexport = $Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/ims_exports'; - my $ims_manifest; - if (!-e $$tempexport) { - mkdir($$tempexport,0700); - } - $$tempexport .= '/'.$now; - if (!-e $$tempexport) { - mkdir($$tempexport,0700); - } - $$tempexport .= '/'.$env{'user.domain'}.'_'.$env{'user.name'}; - if (!-e $$tempexport) { - mkdir($$tempexport,0700); - } - if (!-e "$$tempexport/resources") { - mkdir("$$tempexport/resources",0700); - } -# open manifest file - my $manifest = '/imsmanifest.xml'; - my $manifestfilename = $$tempexport.$manifest; - if ($ims_manifest = Apache::File->new('>'.$manifestfilename)) { - $$manifestok=1; - print $ims_manifest -''."\n". -''."\n". -' - - - - '.$env{'request.course.id'}.' - - '.$env{'course.'.$env{'request.course.id'}.'.description'}.' - - - - '."\n". -' '."\n". -' '."\n". -' '.$env{'course.'.$env{'request.course.id'}.'.description'}.'' - } else { - $$outcome .= 'An error occurred opening the IMS manifest file.
' -; - } - return $ims_manifest; -} - -sub build_package { - my ($now,$navmap,$exportitems,$discussions,$outcome,$tempexport,$copyresult,$ims_manifest) = @_; -# first iterator to look for dependencies - my $it = $navmap->getIterator(undef,undef,undef,1,undef,undef); - my $curRes; - my $count = 0; - my $depth = 0; - my $lastcontainer = 0; - my %parent = (); - my @dependencies = (); - my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; - while ($curRes = $it->next()) { - if (ref($curRes)) { - $count ++; - } - if ($curRes == $it->BEGIN_MAP()) { - $depth++; - $parent{$depth} = $lastcontainer; - } - if ($curRes == $it->END_MAP()) { - $depth--; - $lastcontainer = $parent{$depth}; - } - if (ref($curRes)) { - if ($curRes->is_sequence() || $curRes->is_page()) { - $lastcontainer = $count; - } - if (grep/^$count$/,@$exportitems) { - &get_dependencies($exportitems,\%parent,$depth,\@dependencies); + foreach my $item (keys(%tocopy)) { + unless ($item=~/\.(sequence|page)$/) { + my $currurlpath = $prefix.$item; + my $currdirpath = &Apache::lonnet::filelocation('',$currurlpath); + &recurse_html($mm,$prefix,$currdirpath,$currurlpath,$item,$lookup{$item},\%replacehash,\%deps); } } - } -# second iterator to build manifest and store resources - $it = $navmap->getIterator(undef,undef,undef,1,undef,undef); - $depth = 0; - my $prevdepth; - $count = 0; - my $imsresources; - my $pkgdepth; - while ($curRes = $it->next()) { - if ($curRes == $it->BEGIN_MAP()) { - $prevdepth = $depth; - $depth++; - } - if ($curRes == $it->END_MAP()) { - $prevdepth = $depth; - $depth--; - } - - if (ref($curRes)) { - $count ++; - if ((grep/^$count$/,@$exportitems) || (grep/^$count$/,@dependencies)) { - my $symb = $curRes->symb(); - my $isvisible = 'true'; - my $resourceref; - if ($curRes->randomout()) { - $isvisible = 'false'; - } - unless ($curRes->is_sequence()) { - $resourceref = 'identifierref="RES-'.$env{'request.course.id'}.'-'.$count.'"'; - } - my $step = $prevdepth - $depth; - if (($step >= 0) && ($count > 1)) { - while ($step >= 0) { - print $ims_manifest "\n".' '."\n"; - $step --; - } - } - $prevdepth = $depth; - - my $itementry = - ''. - ''.$curRes->title().''; - print $ims_manifest "\n".$itementry; - - unless ($curRes->is_sequence()) { - my $content_file; - my @hrefs = (); - &process_content($count,$curRes,$cdom,$cnum,$symb,\$content_file,\@hrefs,$copyresult,$tempexport); - if ($content_file) { - $imsresources .= "\n". - ' '."\n". - ' '."\n"; - foreach (@hrefs) { - $imsresources .= - ' '."\n"; - } - if (grep/^$count$/,@$discussions) { - my $ressymb = $symb; - my $mode; - if ($ressymb =~ m|adm/($match_domain)/($match_username)/(\d+)/bulletinboard$|) { - unless ($ressymb =~ m|adm/wrapper/adm|) { - $ressymb = 'bulletin___'.$3.'___adm/wrapper/adm/'.$1.'/'.$2.'/'.$3.'/bulletinboard'; - } - $mode = 'board'; - } - my %extras = ( - caller => 'imsexport', - tempexport => $tempexport.'/resources', - count => $count - ); - my $discresult = &Apache::lonfeedback::list_discussion($mode,undef,$ressymb,\%extras); - } - $imsresources .= ' '."\n"; - } - } - $pkgdepth = $depth; - } - } - } - while ($pkgdepth > 0) { - print $ims_manifest " \n"; - $pkgdepth --; - } - my $resource_text = qq| - - - - $imsresources - - - |; - print $ims_manifest $resource_text; -} - -sub get_dependencies { - my ($exportitems,$parent,$depth,$dependencies) = @_; - if ($depth > 1) { - if ((!grep/^$$parent{$depth}$/,@$exportitems) && (!grep/^$$parent{$depth}$/,@$dependencies)) { - push @$dependencies, $$parent{$depth}; - if ($depth > 2) { - &get_dependencies($exportitems,$parent,$depth-1,$dependencies); - } - } - } -} - -sub process_content { - my ($count,$curRes,$cdom,$cnum,$symb,$content_file,$href,$copyresult,$tempexport) = @_; - my $content_type; - my $message; - my @uploads = (); - if ($curRes->is_sequence()) { - $content_type = 'sequence'; - } elsif ($curRes->is_page()) { - $content_type = 'page'; # need to handle individual items in pages. - } elsif ($symb =~ m-public/$cdom/$cnum/syllabus$-) { - $content_type = 'syllabus'; - my $contents = &Apache::imsexport::templatedpage($content_type); - if ($contents) { - $$content_file = &store_template($contents,$tempexport,$count,$content_type); - } - } elsif ($symb =~ m-\.sequence___\d+___ext-) { - $content_type = 'external'; - my $title = $curRes->title; - my $contents = &Apache::imsexport::external($symb,$title); - if ($contents) { - $$content_file = &store_template($contents,$tempexport,$count,$content_type); - } - } elsif ($symb =~ m-adm/navmaps$-) { - $content_type = 'navmap'; - } elsif ($symb =~ m-adm/[^/]+/[^/]+/(\d+)/smppg$-) { - $content_type = 'simplepage'; - my $contents = &Apache::imsexport::templatedpage($content_type,$1,$count,\@uploads); - if ($contents) { - $$content_file = &store_template($contents,$tempexport,$count,$content_type); - } - } elsif ($symb =~ m-lib/templates/simpleproblem\.problem$-) { - $content_type = 'simpleproblem'; - my $contents = &Apache::imsexport::simpleproblem($symb); - if ($contents) { - $$content_file = &store_template($contents,$tempexport,$count,$content_type); - } - } elsif ($symb =~ m-lib/templates/examupload\.problem$-) { - $content_type = 'examupload'; - } elsif ($symb =~ m-adm/($match_domain)/($match_username)/(\d+)/bulletinboard$-) { - $content_type = 'bulletinboard'; - my $contents = &Apache::imsexport::templatedpage($content_type,$3,$count,\@uploads,$1,$2); - if ($contents) { - $$content_file = &store_template($contents,$tempexport,$count,$content_type); - } - } elsif ($symb =~ m-adm/([^/]+)/([^/]+)/aboutme$-) { - $content_type = 'aboutme'; - my $contents = &Apache::imsexport::templatedpage($content_type,undef,$count,\@uploads,$1,$2); - if ($contents) { - $$content_file = &store_template($contents,$tempexport,$count,$content_type); - } - } elsif ($symb =~ m-\.(sequence|page)___\d+___uploaded/$cdom/$cnum/-) { - $$content_file = &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,$href,'uploaded'); - } elsif ($symb =~ m-\.(sequence|page)___\d+___([^/]+)/([^/]+)-) { - my $canedit = 0; - if ($2 eq $env{'user.domain'} && $3 eq $env{'user.name'}) { - $canedit= 1; - } -# only include problem code where current user is author - if ($canedit) { - $$content_file = &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,$href,'resource'); - } else { - $$content_file = &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,$href,'noedit'); - } - } elsif ($symb =~ m-uploaded/$cdom/$cnum-) { - $$content_file = &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,$href,'uploaded'); - } - if (@uploads > 0) { - foreach my $item (@uploads) { - my $uploadmsg = ''; - &replicate_content($cdom,$cnum,$tempexport,$item,$count,\$uploadmsg,$href,'templateupload'); - if ($uploadmsg) { - $$copyresult .= $uploadmsg."\n"; + foreach my $num (sort {$a <=> $b} (@todump)) { + my $src = $display{$num}; + next if ($src eq ''); + my @needcopy = (); + if ($replacehash{$src}) { + push(@needcopy,$src); + if (ref($deps{$num}) eq 'HASH') { + foreach my $dep (sort(keys(%{$deps{$num}}))) { + if ($replacehash{$dep}) { + push(@needcopy,$dep); + } + } + } + } elsif ($src =~ /^simpleproblem_/) { + push(@needcopy,$src); } - } - } - if ($message) { - $$copyresult .= $message."\n"; - } -} - -sub replicate_content { - my ($cdom,$cnum,$tempexport,$symb,$count,$message,$href,$caller) = @_; - my ($map,$ind,$url); - if ($caller eq 'templateupload') { - $url = $symb; - $url =~ s#//#/#g; - } else { - ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); - } - my $content; - my $filename; - my $repstatus; - my $content_name; - if ($url =~ m-/([^/]+)$-) { - $filename = $1; - if (!-e $tempexport.'/resources') { - mkdir($tempexport.'/resources',0700); - } - if (!-e $tempexport.'/resources/'.$count) { - mkdir($tempexport.'/resources/'.$count,0700); - } - my $destination = $tempexport.'/resources/'.$count.'/'.$filename; - my $copiedfile; - if ($copiedfile = Apache::File->new('>'.$destination)) { - my $content; - if ($caller eq 'resource') { - my $respath = $Apache::lonnet::perlvar{'lonDocRoot'}.'/res'; - my $filepath = &Apache::lonnet::filelocation($respath,$url); - $content = &Apache::lonnet::getfile($filepath); - if ($content eq -1) { - $$message = 'Could not copy file '.$filename; + next if (@needcopy == 0); + my ($result,$depresult); + for (my $i=0; $i<@needcopy; $i++) { + my $item = $needcopy[$i]; + my $newfilename; + if ($simpleproblems{$num}) { + $newfilename=$title.'/'.$simpleproblems{$num}{'name'}; } else { - &extract_media($url,$cdom,$cnum,\$content,$count,$tempexport,$href,$message,'resource'); - $repstatus = 'ok'; + $newfilename=$title.'/'.$replacehash{$item}; } - } elsif ($caller eq 'uploaded' || $caller eq 'templateupload') { - my $rtncode; - $repstatus = &Apache::lonnet::getuploaded('GET',$url,$cdom,$cnum,\$content,$rtncode); - if ($repstatus eq 'ok') { - if ($url =~ /\.html?$/i) { - &extract_media($url,$cdom,$cnum,\$content,$count,$tempexport,$href,$message,'uploaded'); - } + $newfilename=~s/\.(\w+)$//; + my $ext=$1; + $newfilename=&clean($newfilename); + $newfilename.='.'.$ext; + my ($newrelpath) = ($newfilename =~ m{^\Q$title/\E(.+)$}); + if ($newrelpath ne $replacehash{$item}) { + $replacehash{$item} = $newrelpath; + } + my @dirs=split(/\//,$newfilename); + my $path=$r->dir_config('lonDocRoot')."/priv/$cd/$ca"; + my $makepath=$path; + my $fail; + my $origin; + for (my $i=0;$i<$#dirs;$i++) { + $makepath.='/'.$dirs[$i]; + unless (-e $makepath) { + unless(mkdir($makepath,0755)) { + $fail = &mt('Directory creation failed.'); + } + } + } + if ($i == 0) { + $result = '
'.$item.' => '.$newfilename.': '; } else { - $$message = 'Could not render '.$url.' server message - '.$rtncode."
\n"; + $depresult .= '
  • '.$item.' => '.$newfilename.' '. + ''. + &mt('(dependency)').': '; + } + if (-e $path.'/'.$newfilename) { + $fail = &mt('Destination already exists -- not overwriting.'); + } else { + if (my $fh=Apache::File->new('>'.$path.'/'.$newfilename)) { + if (($item =~ m{^/adm/$match_domain/$match_username/\d+/smppg}) || + ($item =~ /^simpleproblem_/)) { + print $fh $newcontent{$item}; + } else { + my $fileloc = &Apache::lonnet::filelocation('',$prefix.$item); + if (-e $fileloc) { + if ($item=~/\.(sequence|page|html|htm|xml|xhtml)$/) { + if ((($1 eq 'sequence') || ($1 eq 'page')) && + (ref($has_simpleprobs{$item}) eq 'HASH')) { + my %changes = %{$has_simpleprobs{$item}}; + my $content = &Apache::lonclonecourse::rewritefile( + &Apache::lonclonecourse::readfile($env{'request.course.id'},$item), + (%replacehash,$crs => '') + ); + my $updatedcontent = ''; + my $parser = HTML::TokeParser->new(\$content); + $parser->attr_encoded(1); + while (my $token = $parser->get_token) { + if ($token->[0] eq 'S') { + if (($token->[1] eq 'resource') && + ($token->[2]->{'src'} eq '/res/lib/templates/simpleproblem.problem') && + ($changes{$token->[2]->{'id'}})) { + my $id = $token->[2]->{'id'}; + $updatedcontent .= '<'.$token->[1]; + foreach my $attrib (@{$token->[3]}) { + next unless ($attrib =~ /^(src|type|title|id)$/); + if ($attrib eq 'src') { + my ($file) = ($display{$changes{$id}} =~ /^\Qsimpleproblem_\E(.+)$/); + if ($file) { + $updatedcontent .= ' '.$attrib.'="'.$file.'"'; + } else { + $updatedcontent .= ' '.$attrib.'="'.$token->[2]->{$attrib}.'"'; + } + } else { + $updatedcontent .= ' '.$attrib.'="'.$token->[2]->{$attrib}.'"'; + } + } + $updatedcontent .= ' />'."\n"; + } else { + $updatedcontent .= $token->[4]."\n"; + } + } else { + $updatedcontent .= $token->[2]; + } + } + print $fh $updatedcontent; + } else { + print $fh &Apache::lonclonecourse::rewritefile( + &Apache::lonclonecourse::readfile($env{'request.course.id'},$item), + (%replacehash,$crs => '') + ); + } + } else { + print $fh + &Apache::lonclonecourse::readfile($env{'request.course.id'},$item); + } + } else { + $fail = &mt('Source does not exist.'); + } + } + $fh->close(); + } else { + $fail = &mt('Could not write to destination.'); + } + } + my $text; + if ($fail) { + $text = ''.&mt('fail').(' 'x3).$fail.''; + } else { + $text = ''.&mt('ok').''; } - } elsif ($caller eq 'noedit') { -# Need to render the resource without the LON-CAPA Internal header and the Post discussion footer, and then set $content equal to this. - $repstatus = 'ok'; - $content = 'Not the owner of this resource'; + if ($i == 0) { + $result .= $text; + } else { + $depresult .= $text.'
    • '; + } } - if ($repstatus eq 'ok') { - print $copiedfile $content; + $r->print($result); + if ($depresult) { + $r->print(''); } - close($copiedfile); - } else { - $$message = 'Could not open destination file for '.$filename."
    \n"; } } else { - $$message = 'Could not determine name of file for '.$symb."
    \n"; - } - if ($repstatus eq 'ok') { - $content_name = 'resources/'.$count.'/'.$filename; - } - return $content_name; -} - -sub extract_media { - my ($url,$cdom,$cnum,$content,$count,$tempexport,$href,$message,$caller) = @_; - my ($dirpath,$container); - my %allfiles = (); - my %codebase = (); - if ($url =~ m-(.*/)([^/]+)$-) { - $dirpath = $1; - $container = $2; - } else { - $dirpath = $url; - $container = ''; - } - &Apache::lonnet::extract_embedded_items(undef,undef,\%allfiles,\%codebase,$content); - foreach my $embed_file (keys(%allfiles)) { - my $filename; - if ($embed_file =~ m#([^/]+)$#) { - $filename = $1; + my ($navmap,$errormsg) = + &Apache::loncourserespicker::get_navmap_object($crstype,'dumpdocs'); + if (!ref($navmap)) { + $r->print($errormsg); } else { - $filename = $embed_file; - } - my $newname = 'res/'.$filename; - my ($rtncode,$embed_content,$repstatus); - my $embed_url; - if ($embed_file =~ m-^/-) { - $embed_url = $embed_file; # points to absolute path - } else { - if ($embed_file =~ m-https?://-) { - next; # points to url - } else { - $embed_url = $dirpath.$embed_file; # points to relative path - } - } - if ($caller eq 'resource') { - my $respath = $Apache::lonnet::perlvar{'lonDocRoot'}.'/res'; - my $embed_path = &Apache::lonnet::filelocation($respath,$embed_url); - $embed_content = &Apache::lonnet::getfile($embed_path); - unless ($embed_content eq -1) { - $repstatus = 'ok'; + $r->print('
    '.&mt('Searching ...').'
    '); + $r->rflush(); + my ($preamble,$formname); + $formname = 'dumpdoc'; + unless ($home==1) { + $preamble = '
    '. + '
    '. + &mt('Select the Authoring Space'). + ''; + } else { + $preamble .= ''; + } + } + unless ($home==1) { + $preamble .= '
    '."\n"; + } + my $title=$origcrsdata{'description'}; + $title=~s/[\/\s]+/\_/gs; + $title=&clean($title); + $preamble .= '
    '. + '
    '.&mt('Folder in Authoring Space').''. + ''. + '
    '."\n"; + my %uploadedfiles; + &tiehash(); + foreach my $file (&Apache::lonclonecourse::crsdirlist($origcrsid,'userfiles')) { + my ($ext)=($file=~/\.(\w+)$/); +# FIXME Check supplemental here + my $title=$hash{'title_'.$hash{ + 'ids_/uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'.$file}}; + if (!$title) { + $title=$file; + } else { + $title=~s|/|_|g; + } + $title=~s/\.(\w+)$//; + $title=&clean($title); + $title.='.'.$ext; +# $r->print("\n" + $uploadedfiles{$file} = $title; + } + &untiehash(); + $r->print(&Apache::loncourserespicker::create_picker($navmap,'dumpdocs',$formname,$crstype,undef, + undef,undef,$preamble,$home,\%uploadedfiles)); + } + } + $r->print(&endContentScreen()); +} + +sub recurse_html { + my ($mm,$prefix,$currdirpath,$currurlpath,$container,$item,$replacehash,$deps) = @_; + return unless ((ref($replacehash) eq 'HASH') && (ref($deps) eq 'HASH')); + my (%allfiles,%codebase); + if (&Apache::lonnet::extract_embedded_items($currdirpath,\%allfiles,\%codebase) eq 'ok') { + if (keys(%allfiles)) { + foreach my $dependency (keys(%allfiles)) { + next if (($dependency =~ m{^/(res|adm)/}) || ($dependency =~ m{^https?://})); + my ($depurl,$relfile,$newcontainer); + if ($dependency =~ m{^/}) { + if ($dependency =~ m{^\Q$currurlpath/\E(.+)$}) { + $relfile = $1; + if ($dependency =~ m{^\Q$prefix\E(.+)$}) { + $newcontainer = $1; + next if ($replacehash->{$newcontainer}); + } + $depurl = $dependency; + } else { + next; + } } else { - $attrib_regexp = $allfiles{$embed_file}[0]; + $relfile = $dependency; + $depurl = $currurlpath; + $depurl =~ s{[^/]+$}{}; + $depurl .= $dependency; + ($newcontainer) = ($depurl =~ m{^\Q$prefix\E(.+)$}); } - $$content =~ s#($attrib_regexp\s*=\s*['"]?)\Q$embed_file\E(['"]?)#$1$newname$2#gi; - if ($caller eq 'resource' && $container =~ /\.(problem|library)$/) { - $$content =~ s#\Q$embed_file\E#$newname#gi; + next if ($relfile eq ''); + my $newname = $replacehash->{$container}; + $newname =~ s{[^/]+$}{}; + $replacehash->{$newcontainer} = $newname.$relfile; + $deps->{$item}{$newcontainer} = 1; + my ($newurlpath) = ($depurl =~ m{^(.*)/[^/]+$}); + my $depfile = &Apache::lonnet::filelocation('',$depurl); + my $type = $mm->checktype_filename($depfile); + if ($type eq 'text/html') { + &recurse_html($mm,$prefix,$depfile,$newurlpath,$newcontainer,$item,$replacehash,$deps); } } - } else { - $$message .= 'replication of embedded file - '.$embed_file.' in '.$url.' failed, reason -'.$rtncode."
    \n"; } } return; } -sub store_template { - my ($contents,$tempexport,$count,$content_type) = @_; - if ($contents) { - if ($tempexport) { - if (!-e $tempexport.'/resources') { - mkdir($tempexport.'/resources',0700); - } - if (!-e $tempexport.'/resources/'.$count) { - mkdir($tempexport.'/resources/'.$count,0700); - } - my $destination = $tempexport.'/resources/'.$count.'/'.$content_type.'.xml'; - my $storetemplate; - if ($storetemplate = Apache::File->new('>'.$destination)) { - print $storetemplate $contents; - close($storetemplate); - } - if ($content_type eq 'external') { - return 'resources/'.$count.'/'.$content_type.'.html'; - } else { - return 'resources/'.$count.'/'.$content_type.'.xml'; - } - } - } -} - -# Imports the given (name, url) resources into the course -# coursenum, coursedom, and folder must precede the list sub group_import { - my ($coursenum, $coursedom, $folder, $container, $caller, @files) = @_; - + my ($coursenum, $coursedom, $folder, $container, $caller, $ltitoolsref, @files) = @_; + my ($donechk,$allmaps,%hierarchy,%titles,%addedmaps,%removefrommap, + %removeparam,$importuploaded,$fixuperrors); + $allmaps = {}; while (@files) { - my $name = shift(@files); - my $url = shift(@files); - #FIXME check if file exists before overwriting, might be restoring it - if (($url =~ m{^/uploaded/\Q$coursedom\E/\Q$coursenum\E/(default_\d+\.)(page|sequence)$}) + my ($name, $url, $residx) = @{ shift(@files) }; + if (($url =~ m{^/uploaded/\Q$coursedom\E/\Q$coursenum\E/(default_\d+\.)(page|sequence)$}) && ($caller eq 'londocs') && (!&Apache::lonnet::stat_file($url))) { - + my $errtext = ''; my $fatal = 0; my $newmapstr = ''."\n". @@ -924,8 +647,8 @@ sub group_import { $env{'form.output'}=$newmapstr; my $result=&Apache::lonnet::finishuserfileupload($coursenum,$coursedom, 'output',$1.$2); - if ($result != m|^/uploaded/|) { - $errtext.='Map not saved: A network error occured when trying to save the new map. '; + if ($result !~ m{^/uploaded/}) { + $errtext.='Map not saved: A network error occurred when trying to save the new map. '; $fatal = 2; } if ($fatal) { @@ -933,73 +656,265 @@ sub group_import { } } if ($url) { - my $idx = &LONCAPA::map::getresidx($url); - $LONCAPA::map::order[$#LONCAPA::map::order+1]=$idx; + if ($url =~ m{^(/adm/$coursedom/$coursenum/(\d+)/ext\.tool)\:?(.*)$}) { + $url = $1; + my $marker = $2; + my $info = $3; + my ($toolid,%toolhash,%toolsettings); + my @extras = ('linktext','explanation','crslabel','crstitle','crsappend'); + my @toolinfo = split(/:/,$info); + if ($residx) { + %toolsettings=&Apache::lonnet::dump('exttool_'.$marker,$coursedom,$coursenum); + $toolid = $toolsettings{'id'}; + } else { + $toolid = shift(@toolinfo); + } + $toolid =~ s/\D//g; + ($toolhash{'target'},$toolhash{'width'},$toolhash{'height'}, + $toolhash{'linktext'},$toolhash{'explanation'},$toolhash{'crslabel'}, + $toolhash{'crstitle'},$toolhash{'crsappend'},$toolhash{'gradable'}) = @toolinfo; + foreach my $item (@extras) { + $toolhash{$item} = &unescape($toolhash{$item}); + } + if ($folder =~ /^supplemental/) { + delete($toolhash{'gradable'}); + } + if (ref($ltitoolsref) eq 'HASH') { + if (ref($ltitoolsref->{$toolid}) eq 'HASH') { + my @deleted; + $toolhash{'id'} = $toolid; + if (($toolhash{'target'} eq 'iframe') || ($toolhash{'target'} eq 'tab') || + ($toolhash{'target'} eq 'window')) { + if ($toolhash{'target'} eq 'window') { + foreach my $item ('width','height') { + $toolhash{$item} =~ s/^\s+//; + $toolhash{$item} =~ s/\s+$//; + if ($toolhash{$item} =~ /\D/) { + delete($toolhash{$item}); + if ($residx) { + if ($toolsettings{$item}) { + push(@deleted,$item); + } + } + } + } + } + } elsif ($residx) { + $toolhash{'target'} = $toolsettings{'target'}; + if ($toolhash{'target'} eq 'window') { + foreach my $item ('width','height') { + $toolhash{$item} = $toolsettings{$item}; + } + } + } elsif (ref($ltitoolsref->{$toolid}->{'display'}) eq 'HASH') { + $toolhash{'target'} = $ltitoolsref->{$toolid}->{'display'}->{'target'}; + if ($toolhash{'target'} eq 'window') { + $toolhash{'width'} = $ltitoolsref->{$toolid}->{'display'}->{'width'}; + $toolhash{'height'} = $ltitoolsref->{$toolid}->{'display'}->{'height'}; + } + } + if ($toolhash{'target'} eq 'iframe') { + foreach my $item ('width','height','linktext','explanation') { + delete($toolhash{$item}); + if ($residx) { + if ($toolsettings{$item}) { + push(@deleted,$item); + } + } + } + } elsif ($toolhash{'target'} eq 'tab') { + foreach my $item ('width','height') { + delete($toolhash{$item}); + if ($residx) { + if ($toolsettings{$item}) { + push(@deleted,$item); + } + } + } + } + if (ref($ltitoolsref->{$toolid}->{'crsconf'}) eq 'HASH') { + foreach my $item ('label','title','linktext','explanation') { + my $crsitem; + if (($item eq 'label') || ($item eq 'title')) { + $crsitem = 'crs'.$item; + } else { + $crsitem = $item; + } + if ($ltitoolsref->{$toolid}->{'crsconf'}->{$item}) { + $toolhash{$crsitem} =~ s/^\s+//; + $toolhash{$crsitem} =~ s/\s+$//; + if ($toolhash{$crsitem} eq '') { + delete($toolhash{$crsitem}); + } + } else { + delete($toolhash{$crsitem}); + } + if (($residx) && (exists($toolsettings{$crsitem}))) { + unless (exists($toolhash{$crsitem})) { + push(@deleted,$crsitem); + } + } + } + } + if ($toolhash{'passback'}) { + my $gradesecret = UUID::Tiny::create_uuid_as_string(UUID_V4); + $toolhash{'gradesecret'} = $gradesecret; + $toolhash{'gradesecretdate'} = time; + } + if ($toolhash{'roster'}) { + my $rostersecret = UUID::Tiny::create_uuid_as_string(UUID_V4); + $toolhash{'rostersecret'} = $rostersecret; + $toolhash{'rostersecretdate'} = time; + } + my $changegradable; + if (($residx) && ($folder =~ /^default/)) { + if (exists($toolsettings{'gradable'})) { + if (!exists($toolhash{'gradable'})) { + push(@deleted,'gradable'); + $changegradable = 1; + } + } elsif (exists($toolhash{'gradable'})) { + $changegradable = 1; + } + } + my $putres = &Apache::lonnet::put('exttool_'.$marker,\%toolhash,$coursedom,$coursenum); + if ($putres eq 'ok') { + if (@deleted) { + &Apache::lonnet::del('exttool_'.$marker,\@deleted,$coursedom,$coursenum); + } + if (($changegradable) && ($folder =~ /^default/)) { + my $val; + if ($toolhash{'gradable'}) { + $val = 'yes'; + } else { + $val = 'no'; + } + &LONCAPA::map::storeparameter($residx,'parameter_0_gradable',$val, + 'string_yesno'); + &remember_parms($residx,'gradable','set',$val); + } + } else { + return (&mt('Failed to save update to external tool.'),1); + } + } + } + } + if (($caller eq 'londocs') && + ($folder =~ /^default/)) { + if (($url =~ /\.(page|sequence)$/) && (!$donechk)) { + my $chome = &Apache::lonnet::homeserver($coursenum,$coursedom); + my $cid = $coursedom.'_'.$coursenum; + $allmaps = + &Apache::loncommon::allmaps_incourse($coursedom,$coursenum, + $chome,$cid); + $donechk = 1; + } + if ($url =~ m{^/uploaded/\Q$coursedom\E/\Q$coursenum\E/(default_\d+\.)(page|sequence)$}) { + &contained_map_check($url,$folder,$coursenum,$coursedom,\%removefrommap, + \%removeparam,\%addedmaps,\%hierarchy,\%titles,$allmaps); + $importuploaded = 1; + } elsif ($url =~ m{^/res/.+\.(page|sequence)$}) { + next if ($allmaps->{$url}); + } + } + if (!$residx + || defined($LONCAPA::map::zombies[$residx])) { + $residx = &LONCAPA::map::getresidx($url,$residx); + push(@LONCAPA::map::order, $residx); + } my $ext = 'false'; if ($url=~m{^http://} || $url=~m{^https://}) { $ext = 'true'; } - $url = &LONCAPA::map::qtunescape($url); $name = &LONCAPA::map::qtunescape($name); - $LONCAPA::map::resources[$idx] = - join ':', ($name, $url, $ext, 'normal', 'res'); + if ($name eq '') { + $name = &LONCAPA::map::qtunescape(&mt('Web Page')); + } + if ($url =~ m{^/uploaded/$coursedom/$coursenum/((?:docs|supplemental)/(?:default|\d+))/new\.html$}) { + my $filepath = $1; + my $fname = $name; + if ($fname =~ /^\W+$/) { + $fname = 'web'; + } else { + $fname =~ s/\W/_/g; + } + if (length($fname) > 15) { + $fname = substr($fname,0,14); + } + my $initialtext = &mt('Replace with your own content.'); + my $newhtml = < + +$name + + +$initialtext + + +END + $env{'form.output'}=$newhtml; + my $result = + &Apache::lonnet::finishuserfileupload($coursenum,$coursedom, + 'output', + "$filepath/$residx/$fname.html"); + if ($result =~ m{^/uploaded/}) { + $url = $result; + if ($filepath =~ /^supplemental/) { + $name = time.'___&&&___'.$env{'user.name'}.'___&&&___'. + $env{'user.domain'}.'___&&&___'.$name; + } + } else { + return (&mt('Failed to save new web page.'),1); + } + } + $url = &LONCAPA::map::qtunescape($url); + $LONCAPA::map::resources[$residx] = + join(':', ($name, $url, $ext, 'normal', 'res')); } } - return &storemap($coursenum, $coursedom, $folder.'.'.$container); -} - -sub breadcrumbs { - my ($where)=@_; - &Apache::lonhtmlcommon::clear_breadcrumbs(); - my (@folders); - if ($env{'form.pagepath'}) { - @folders = split('&',$env{'form.pagepath'}); - } else { - @folders=split('&',$env{'form.folderpath'}); - } - my $folderpath; - my $cpinfo=''; - my $plain=''; - if ($env{'form.markedcopy_url'}) { - $cpinfo='&markedcopy_url='. - &escape($env{'form.markedcopy_url'}). - '&markedcopy_title='. - &escape($env{'form.markedcopy_title'}); - } - my $randompick=-1; - my $isencrypted=0; - my $ishidden=0; - while (@folders) { - my $folder=shift(@folders); - my $foldername=shift(@folders); - if ($folderpath) {$folderpath.='&';} - $folderpath.=$folder.'&'.$foldername; - my $url='/adm/coursedocs?folderpath='. - &escape($folderpath); - my $name=&unescape($foldername); -# randompick number, hidden, encrypted is appended with ":"s to the foldername - $name=~s/\:(\d*)\:(\w*)\:(\w*)$//; - if ($1 ne '') { - $randompick=$1; - } else { - $randompick=-1; - } - if ($2) { $ishidden=1; } - if ($3) { $isencrypted=1; } - &Apache::lonhtmlcommon::add_breadcrumb( - {'href'=>$url.$cpinfo, - 'title'=>$name, - 'text'=>''. - $name.'', - 'no_mt'=>1, - }); - $plain.=$name.' > '; - } - $plain=~s/\>\;\s*$//; - return (&Apache::lonhtmlcommon::breadcrumbs(undef,undef,0,'nohelp', - 'LC_docs_path'),$randompick,$ishidden,$isencrypted,$plain); + if ($importuploaded) { + my %import_errors; + my %updated = ( + removefrommap => \%removefrommap, + removeparam => \%removeparam, + ); + my ($result,$msgsarray,$lockerror) = + &apply_fixups($folder,1,$coursedom,$coursenum,\%import_errors,\%updated); + if (keys(%import_errors) > 0) { + $fixuperrors = + '

    '."\n". + &mt('The following files are either dependencies of a web page or references within a folder and/or composite page for which errors occurred during import:')."\n". + '

    '."\n"; + } + if (ref($msgsarray) eq 'ARRAY') { + if (@{$msgsarray} > 0) { + $fixuperrors .= '

    '. + join('
    ',@{$msgsarray}). + '

    '; + } + } + if ($lockerror) { + $fixuperrors .= '

    '. + $lockerror. + '

    '; + } + } + my ($errtext,$fatal) = + &storemap($coursenum, $coursedom, $folder.'.'.$container,1); + unless ($fatal) { + if ($folder =~ /^supplemental/) { + &Apache::lonnet::get_numsuppfiles($coursenum,$coursedom,1); + my ($errtext,$fatal) = &mapread($coursenum,$coursedom, + $folder.'.'.$container); + } + } + return ($errtext,$fatal,$fixuperrors); } sub log_docs { - return &Apache::lonnet::instructor_log('docslog',@_); + return &Apache::lonnet::write_log('course','docslog',@_); } { @@ -1033,7 +948,7 @@ sub log_docs { 'currentfolder' => $env{'form.folder'}); if ($parmidx) { $storehash{'parameter_res'}=$oldresources[$parmidx]; - foreach my $parm (keys %parmaction) { + foreach my $parm (keys(%parmaction)) { $storehash{'parameter_action_'.$parm}=$parmaction{$parm}; $storehash{'parameter_value_'.$parm}=$parmvalue{$parm}; } @@ -1059,38 +974,75 @@ sub log_docs { } } - -# -# Docs Change Log -# sub docs_change_log { - my ($r)=@_; - my $folder=$env{'form.folder'}; - $r->print(&Apache::loncommon::start_page('Course Document Change Log')); - $r->print(&Apache::lonhtmlcommon::breadcrumbs('Course Document Change Log')); + my ($r,$coursenum,$coursedom,$folder,$allowed,$crstype,$iconpath,$canedit)=@_; + my $supplementalflag=($env{'form.folderpath'}=~/^supplemental/); + my $navmap; + my $js = ''."\n"; + $r->print(&Apache::loncommon::start_page('Content Change Log',$js)); + $r->print(&Apache::lonhtmlcommon::breadcrumbs('Content Change Log')); + $r->print(&startContentScreen(($supplementalflag?'suppdocs':'docs'))); + my %orderhash; + my $container='sequence'; + my $pathitem; + if ($env{'form.folderpath'} =~ /\:1$/) { + $container='page'; + } + my $folderpath=$env{'form.folderpath'}; + if ($folderpath eq '') { + $folderpath = &default_folderpath($coursenum,$coursedom,\$navmap); + } + undef($navmap); + $pathitem = ''; + my $readfile="/uploaded/$coursedom/$coursenum/$folder.$container"; + my $jumpto = $readfile; + $jumpto =~ s{^/}{}; + my $tid = 1; + if ($supplementalflag) { + $tid = 2; + } + my ($breadcrumbtrail) = + &Apache::lonhtmlcommon::docs_breadcrumbs($allowed,$crstype,1); + $r->print($breadcrumbtrail. + &generate_edit_table($tid,\%orderhash,undef,$iconpath,$jumpto, + $readfile)); my %docslog=&Apache::lonnet::dump('nohist_docslog', $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); if ((keys(%docslog))[0]=~/^error\:/) { undef(%docslog); } - $r->print('
    '. - ''); - my %saveable_parameters = ('show' => 'scalar',); &Apache::loncommon::store_course_settings('docs_log', \%saveable_parameters); &Apache::loncommon::restore_course_settings('docs_log', \%saveable_parameters); if (!$env{'form.show'}) { $env{'form.show'}=10; } +# FIXME: internationalization seems wrong here my %lt=('hiddenresource' => 'Resources hidden', 'encrypturl' => 'URL hidden', 'randompick' => 'Randomly pick', + 'randomorder' => 'Randomly ordered', + 'gradable' => 'Grade can be assigned to External Tool', 'set' => 'set to', 'del' => 'deleted'); - $r->print(&Apache::loncommon::display_filter(). - ''. - '
    '); + my $filter = &Apache::loncommon::display_filter('docslog')."\n". + $pathitem."\n". + ''. + (' 'x2).''; + $r->print('
    '. + '
    '.&mt('Display of Content Changes').''."\n". + &makedocslogform($filter,1). + '

    '); $r->print(&Apache::loncommon::start_data_table().&Apache::loncommon::start_data_table_header_row(). ''.&mt('Time').''.&mt('User').''.&mt('Folder').''.&mt('Before').''. &mt('After').''. @@ -1107,7 +1059,7 @@ sub docs_change_log { foreach my $key (@changes) { $wholeentry.=':'.$docslog{$id}{'logentry'}{$key}; } - if ($wholeentry!~/\Q$env{'form.containingphrase'}\E/i) { next; } + if ($wholeentry!~/\Q$env{'form.containingphrase'}\E/i) { next; } } my $count = 0; my $time = @@ -1134,18 +1086,30 @@ sub docs_change_log { ':'.$docslog{$id}{'exe_udom'}.''. $send_msg_link.''. $docslog{$id}{'logentry'}{'folder'}.''); + my $is_supp = 0; + if ($docslog{$id}{'logentry'}{'currentfolder'} =~ /^supplemental/) { + $is_supp = 1; + } # Before for (my $idx=0;$idx<=$docslog{$id}{'logentry'}{'maxidx'};$idx++) { my $oldname=(split(/\:/,$docslog{$id}{'logentry'}{'before_resources_'.$idx}))[0]; my $newname=(split(/\:/,$docslog{$id}{'logentry'}{'after_resources_'.$idx}))[0]; if ($oldname ne $newname) { - $r->print(&LONCAPA::map::qtescape($oldname)); + my $shown = &LONCAPA::map::qtescape($oldname); + if ($is_supp) { + $shown = &Apache::loncommon::parse_supplemental_title($shown); + } + $r->print($shown); } } $r->print(''); @@ -1155,21 +1119,30 @@ sub docs_change_log { for (my $idx=0;$idx<=$docslog{$id}{'logentry'}{'maxidx'};$idx++) { my $oldname=(split(/\:/,$docslog{$id}{'logentry'}{'before_resources_'.$idx}))[0]; my $newname=(split(/\:/,$docslog{$id}{'logentry'}{'after_resources_'.$idx}))[0]; - if ($oldname ne $newname) { - $r->print(&LONCAPA::map::qtescape($newname)); + if ($oldname ne '' && $oldname ne $newname) { + my $shown = &LONCAPA::map::qtescape($newname); + if ($is_supp) { + $shown = &Apache::loncommon::parse_supplemental_title(&LONCAPA::map::qtescape($newname)); + } + $r->print($shown); } - } + } $r->print(''); if ($docslog{$id}{'logentry'}{'parameter_res'}) { $r->print(&LONCAPA::map::qtescape((split(/\:/,$docslog{$id}{'logentry'}{'parameter_res'}))[0]).':