--- loncom/interface/londocs.pm 2007/07/12 23:56:29 1.289 +++ loncom/interface/londocs.pm 2024/12/28 12:19:21 1.715 @@ -1,7 +1,7 @@ # The LearningOnline Network # Documents # -# $Id: londocs.pm,v 1.289 2007/07/12 23:56:29 albertel Exp $ +# $Id: londocs.pm,v 1.715 2024/12/28 12:19:21 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -33,15 +33,28 @@ 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::loncourserespicker(); use HTML::Entities; +use HTML::TokeParser; +use HTML::LCParser; 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 +65,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 +79,39 @@ 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; + } elsif ($contentchg) { + $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)\.(.+)$/) { + my @ids=&Apache::lonnet::current_machine_ids(); + 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'}; @@ -103,816 +120,1403 @@ 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 ''; } - 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; + } +} + +sub validate_supppath { + my ($coursenum,$coursedom) = @_; + my $backto; + if ($env{'form.supppath'} ne '') { + my @items = split(/\&/,$env{'form.supppath'}); + my ($badpath,$got_supp,$supppath,%supphidden,%suppids); + for (my $i=0; $i<@items; $i++) { + my $odd = $i%2; + if ((!$odd) && ($items[$i] !~ /^supplemental(|_\d+)$/)) { + $badpath = 1; + last; + } elsif ($odd) { + my $suffix; + my $idx = $i-1; + if ($items[$i] =~ /^([^:]*)::(|1):::$/) { + $backto .= '&'.$1; + } elsif ($items[$idx] eq 'supplemental') { + $backto .= '&'.$items[$i]; + } else { + $backto .= '&'.$items[$i]; + my $is_hidden; + unless ($got_supp) { + my ($supplemental) = &Apache::loncommon::get_supplemental($coursenum,$coursedom); + if (ref($supplemental) eq 'HASH') { + if (ref($supplemental->{'hidden'}) eq 'HASH') { + %supphidden = %{$supplemental->{'hidden'}}; + } + if (ref($supplemental->{'ids'}) eq 'HASH') { + %suppids = %{$supplemental->{'ids'}}; + } + } + $got_supp = 1; + } + if (ref($suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}) eq 'ARRAY') { + my $mapid = $suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}->[0]; + if ($supphidden{$mapid}) { + $is_hidden = 1; + } + } + $suffix = '::'.$is_hidden.':::'; + } + $supppath .= '&'.$items[$i].$suffix; + } else { + $supppath .= '&'.$items[$i]; + $backto .= '&'.$items[$i]; + } + } + if ($badpath) { + delete($env{'form.supppath'}); + } else { + $supppath =~ s/^\&//; + $backto =~ s/^\&//; + $env{'form.supppath'} = $supppath; + } + } + return $backto; } -# -------------------------------------------------------- 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 uploaded content to Authoring Space',$js,$starthash)."\n". + &Apache::lonhtmlcommon::breadcrumbs('Copy uploaded content to Authoring Space')."\n"); + $r->print(&startContentScreen('tools')); my ($home,$other,%outhash)=&authorhosts(); - unless ($home) { return ''; } + unless ($home) { + $r->print('

'.&mt('No author or co-author roles on this server.').'

'); + $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('

'.&mt('Selected Authoring Space is not on this server.').'

'. + &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(''.&mt('fail').''); - } else { - $r->print(''.&mt('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; + 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; + } + } + } + } + $replacehash{'/'.$simplepages{$item}{'res'}} = $simplepages{$item}{'name'}; + $lookup{'/'.$simplepages{$item}{'res'}} = $item; + my $content = ' + + +'.$pagetitle.' + +'; + if ($contents{title}) { + $content .= "\n".'

'.$contents{title}.'

'; + } + if ($contents{image}) { + $content .= "\n".$contents{image}; + } + if ($contents{content}) { + $content .= ' +
+

'.&mt('Content').'

'. +$contents{content}.' +
'; + } + if ($contents{webreferences}) { + $content .= ' +
+

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

'. +$contents{webreferences}.' +
'; + } + $content .= ' + + +'; + $newcontent{'/'.$simplepages{$item}{res}} = $content; } - if ($curRes == $it->END_MAP()) { - $depth--; - $lastcontainer = $parent{$depth}; + } + 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); } - 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'; + } + 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); + } } } - my $color = $count%2; - $display .=''; - if ($discussiontime{$ressymb} > 0) { - $boards ++; - $currelem = $count+$boards+$startcount; - $display .= ''."\n"; + 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 { - $display .= ''."\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').''; + } + if ($i == 0) { + $result .= $text; + } else { + $depresult .= $text.'
    • '; + } + } + $r->print($result); + if ($depresult) { + $r->print(''); } - } - 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'".')"'; - } - $display .= ' />'."\n"; - for (my $i=0; $i<$depth; $i++) { - $display .= ''."\n"; + } elsif ($src =~ /^simpleproblem_/) { + push(@needcopy,$src); + } + 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 { + $newfilename=$title.'/'.$replacehash{$item}; } - if ($curRes->is_sequence()) { - $display .= ' '."\n"; - $lastcontainer = $count + $startcount + $boards; - } elsif ($curRes->is_page()) { - $display .= ' '."\n"; - $lastcontainer = $count + $startcount + $boards; + $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 $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); - } - } - } -# 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); - } +ENDJS + } elsif ($home) { + $js = <<"ENDJS"; + + +ENDJS } + $js .= <<"ENDJS"; + +ENDJS + + $js .= "\n".&Apache::lonhtmlcommon::scripttag(&Apache::loncommon::browser_and_searcher_javascript())."\n"; + $starthash = { + add_entries => {'onload' => "hide_searching(); init_copycrs_form();"}, + }; + } + $r->print(&Apache::loncommon::start_page('Copy from Course Authoring to User Authoring',$js,$starthash)."\n". + &Apache::lonhtmlcommon::breadcrumbs('Copy from Course Authoring Space')."\n"); + $r->print(&startContentScreen('tools')); + unless ($home) { + $r->print('

    '.&mt('No author or co-author roles on this server.').'

    '); + $r->print(&endContentScreen()); + return ''; + } + my $docroot = $r->dir_config('lonDocRoot'); + my $is_course_home; + my @ids=&Apache::lonnet::current_machine_ids(); + if (($coursehome ne '') && (grep(/^\Q$coursehome\E$/,@ids))) { + $is_course_home = 1; + } + my $exclude = &Apache::lonnet::priv_exclude(); + my $srcurl = "/priv/$coursedom/$coursenum"; + my $srctop = $docroot.$srcurl; + my $resurl = "/res/$coursedom/$coursenum"; + my $res_exclude = &Apache::lonnet::res_exclude(); + if (($env{'form.authorspace'}) && ($env{'form.authorfolder'}=~/\w/)) { + $r->print('

    '.&mt('Copying Files and/or Sub-directories').'

    '); + if ($readonly) { + $r->print('

    '. + &mt('You do not have permission to copy files and/or directories from Course Authoring Space.'). + '

    '. + &endContentScreen()); + return ''; + } + unless ($outhash{'home_'.$env{'form.authorspace'}}) { + $r->print('

    '.&mt('Selected Authoring Space is not on this server.').'

    '. + &endContentScreen()); + return ''; + } + my ($ca,$cd)=split(/\:/,$env{'form.authorspace'}); + my $desturl = "/priv/$cd/$ca"; + my $destresurl = "/res/$cd/$ca"; + my $desttop = $docroot.$desturl; + my $subdir = &clean($env{'form.authorfolder'}); + $subdir = &cleandir($subdir); + if ($subdir eq '') { + $r->print('

    '.&mt('After removal of disallowed characters target sub-directory name was blank.').'

    '. + &endContentScreen()); + return ''; + } elsif ($subdir =~/^_+$/) { + $r->print('

    '.&mt('After replacement of non-alphanumeric characters with _ in target sub-directory name, nothing but underscores was left.').'

    '. + &endContentScreen()); + return ''; + } + my (%tocopy,%dirs_to_make,%files_to_copy); + map { $tocopy{&unescape($_)} = 1; } &Apache::loncommon::get_env_multiple('form.copytouser'); + if (keys(%tocopy)) { + my (%subdirs,%files); + &Apache::lonnet::recursedirs($is_course_home,1,undef,$exclude,0,0,$srcurl,'',\%subdirs,\%files); + foreach my $possible (sort(keys(%tocopy))) { + if ($possible =~ m{/$}) { + my $possdir = $possible; + $possdir =~ s{^/+|/+$}{}g; + if (exists($subdirs{$possdir})) { + $dirs_to_make{$possdir} = 1; + } else { + delete($tocopy{$possible}); + } } else { - &extract_media($url,$cdom,$cnum,\$content,$count,$tempexport,$href,$message,'resource'); - $repstatus = 'ok'; + my ($path,$fname) = ($possible =~ m{(.*/)([^/]+)$}); + my $found = 0; + if ($path eq '/') { + if (ref($files{$path}) eq 'HASH') { + if (exists($files{$path}{$fname})) { + $found = 1; + $files_to_copy{$fname} = 1; + } + } + } else { + $path =~ s{^/+|/+$}{}g; + if (ref($files{$path}) eq 'HASH') { + if (exists($files{$path}{$fname})) { + $dirs_to_make{$path} = 1; + $files_to_copy{"$path/$fname"} = 1; + $found = 1; + } + } + } + unless ($found) { + delete($tocopy{$possible}); + } } - } 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'); + } + } else { + $r->print('

    '.&mt('No files or directories selected for copying').'

    '); + $r->print(&endContentScreen()); + return ''; + } + if (keys(%tocopy)) { + my (%resdirs,%resfiles); + &Apache::lonnet::recursedirs($is_course_home,1,undef,$res_exclude,0,0,$resurl,'',\%resdirs,\%resfiles); + my ($notopdir,%newdir,%newfile,%checkdeps); + $r->print('

    '.&mt('Copy to: [_1]', + ''.$desturl.'/'.$subdir.''). + '

    '."\n"); + if (keys(%dirs_to_make)) { + unless (-e $desttop.'/'.$subdir) { + mkdir($desttop.'/'.$subdir,0755); + } + if (-e $desttop.'/'.$subdir) { + foreach my $dir (sort(keys(%dirs_to_make))) { + my @dirs=split(/\//,$dir); + my $path="$desttop/$subdir"; + my $makepath=$path; + my $fail; + for (my $i=0;$i<@dirs;$i++) { + $makepath.='/'.$dirs[$i]; + unless (-e $makepath) { + unless (mkdir($makepath,0755)) { + $fail = 1; + last; + } + if (($i == scalar(@dirs)-1) && (!$fail)) { + $newdir{$dir} = 1; + } + } + } + if ($fail) { + $r->print('

    '.&mt('Target directory: [_1] does not exist, and could not be created.', + ''.$desturl.'/'.$subdir.'/'.$dir.''). + '

    '."\n"); + } } } else { - $$message = 'Could not render '.$url.' server message - '.$rtncode."
    \n"; + $notopdir = 1; } - } 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 ($repstatus eq 'ok') { - print $copiedfile $content; + if (keys(%files_to_copy)) { + unless (-e $desttop.'/'.$subdir) { + mkdir($desttop.'/'.$subdir,0755); + } + if (-e $desttop.'/'.$subdir) { + my $num = 0; + my ($copyright,$customdistfile); + if ($env{'form.copyright'} eq 'default' || $env{'form.copyright'} eq 'domain' || $env{'form.copyright'} eq 'public') { + $copyright = $env{'form.copyright'}; + } elsif ($env{'form.copyright'} eq 'custom') { + if ($env{'form.customrights'} =~ m{^/res/$match_domain/$match_username/.+\.rights$}) { + my ($rightsdom,$rightsuname) = ($1,$2); + my $rightshome = &Apache::lonnet::homeserver($rightsdom,$rightsuname); + if (($rightshome eq 'no_host') || ($rightshome eq '')) { + $copyright = 'default'; + } elsif (grep(/^\Q$rightshome\E$/,@ids)) { + if (-e $docroot.$env{'form.customrights'}) { + $copyright = 'custom'; + $customdistfile = $env{'form.customrights'}; + } else { + $copyright = 'default'; + } + } else { + my $rightsfile = &Apache::lonnet::filelocation('',$env{'form.customrights'}); + unless (&Apache::lonnet::getfile($rightsfile) eq '-1') { + $customdistfile = $env{'form.customrights'}; + } + } + } + } + my $sourceavail; + if ($env{'form.sourceavail'} =~ /^(open|closed)$/) { + $sourceavail = $env{'form.sourceavail'}; + } + my $respublish; + if ($env{'form.respublish'}) { + $respublish = 1; + } + my $nokeyref = &Apache::lonpublisher::getnokey($r->dir_config('lonIncludes')); + foreach my $file (keys(%files_to_copy)) { + my ($fail,$dup,$dir_is_file,$src,$dest,$path,$fname); + if ($file =~ m{/}) { + ($path,$fname) = ($file =~ m{^(.+)/([^/]+)$}); + if (-d "$desttop/$subdir/$path") { + if (-e "$desttop/$subdir/$path/$fname") { + $dup = 1; + } else { + $src = "$srctop/$path/$fname"; + $dest = "$desttop/$subdir/$path/$fname"; + } + } elsif (-f "$desttop/$subdir/$path") { + $dir_is_file = 1; + } else { + $fail = 1; + } + } elsif (-e "$desttop/$subdir/$file") { + $dup = 1; + } else { + $src = "$srctop/$file"; + $dest = "$desttop/$subdir/$file"; + $fname = $file; + } + if ($fail) { + $r->print('

    '.&mt('Target directory: [_1] does not exist, and could not be created.', + ''.$desturl.'/'.$subdir.'/'.$path.''). + '

    '."\n"); + } elsif ($dup) { + $r->print('

    '.&mt('Target file: [_1] already exists -- not overwriting.', + ''.$desturl.'/'.$subdir.'/'.$file.''). + '

    '."\n"); + } elsif ($dir_is_file) { + $r->print('

    '.&mt('Target directory: [_1] name is already in a use for a file -- not overwriting.', + ''.$desturl.'/'.$subdir.'/'.$file.''). + '

    '."\n"); + } elsif (($src ne '') && ($dest ne '')) { + if ($is_course_home) { + if (&File::Copy::copy($src,$dest)) { + $newfile{$file} = 1; + } + } else { + if (&Apache::lonnet::repcopy_crsprivfile($srcurl.'/'.$file,$dest) eq 'ok') { + $newfile{$file} = 1; + } + } + if ($newfile{$file}) { + my $gotmeta; + if ($is_course_home) { + if ((-e $src.'.meta') && (!-e $dest.'.meta')) { + if (&File::Copy::copy($src.'.meta',$dest.'.meta')) { + $gotmeta = 1; + } + } + } else { + if (&Apache::lonnet::repcopy_crsprivfile($srcurl.'/'.$file.'.meta',$dest.'.meta') eq 'ok') { + $gotmeta = 1; + } + } + if ($gotmeta) { + if (open(my $fh,'<',$dest.'.meta')) { + my ($output,$now,setsourceavail); + $now = time; + if (($file =~ /\.(xml|html|htm|xhtml|xhtm)$/i) || ($file =~ /$LONCAPA::assess_re/)) { + $setsourceavail = 1; + } + while (my $line=<$fh>) { + chomp($line); + if ($line eq "$coursenum:$coursedom") { + $output .= "$ca:$cd\n"; + } elsif ($line eq 'custom') { + $output .= "$copyright\n"; + } elsif ($line =~ m{^\d+$}) { + $output .= "$now\n"; + } elsif ($line eq "/res/$coursedom/$coursenum/default.rights") { + $output .= "$customdistfile\n"; + } elsif ($line =~ m{^(open|closed)$}) { + if ($setsourceavail) { + $output .= "$sourceavail\n"; + } + } elsif ($line eq "$coursedom") { + $output .= "$cd\n"; + } elsif ($line =~ m{^\d+$}) { + $output .= "$now\n"; + } elsif ($line =~ m{^$match_username:$match_domain$}) { + $output .= "$env{'user.name'}:$env{'user.domain'}\n"; + } elsif ($line eq "$coursenum:$coursedom") { + $output .= "$ca:$cd\n"; + } elsif ($line =~ m{^(.+)$}) { + my @deps = split(/\s*,\s*/,$1); + my @newdeps; + my $changed = 0; + foreach my $dep (@deps) { + if ($dep =~ m{^/res/$coursedom/$coursenum/(.+)$}) { + my $rest = $1; + push(@newdeps,"/res/$cd/$ca/$rest"); + $checkdeps{$rest} = 1; + $changed ++; + } else { + push(@newdeps,$dep); + } + } + if ($changed) { + $output .= ''.join(',',@newdeps).''."\n"; + } + } else { + $output .= "$line\n"; + } + } + close($fh); + if (open(my $fh,'>',$dest.'.meta')) { + print $fh $output; + close($fh); + } + } + } + my ($ext) = ($file =~ /\.(\w+)$/); + my $embstyle=&Apache::loncommon::fileembstyle($ext); + if ($embstyle eq 'ssi') { + my $outstring=''; + my $changes = 0; + my @parser; + $parser[0]=HTML::LCParser->new($dest); + $parser[-1]->xml_mode(1); + my $token; + while (@parser) { + while ($token=$parser[-1]->get_token) { + if ($token->[0] eq 'S') { + my $tag=$token->[1]; + my $lctag=lc($tag); + my %parms=%{$token->[2]}; + foreach my $type ('src','href','background','bgimg') { + foreach my $key (keys(%parms)) { + if ($key =~ /^$type$/i) { + next if (($lctag eq 'img') && ($type eq 'src') && + ($parms{$key} =~ m{^data\:image/gif;base64,})); + if ($parms{$key} =~ m{^\Q/res/$coursedom/$coursenum/\E}si) { + $parms{$key} =~ s{^\Q/res/$coursedom/$coursenum/\E}{/res/$cd/$ca/$subdir/}si; + $changes ++; + } + } + } + } + # probably a image type