--- loncom/interface/londocs.pm 2008/11/18 19:14:22 1.316 +++ loncom/interface/londocs.pm 2025/01/07 21:01:37 1.722 @@ -1,7 +1,7 @@ # The LearningOnline Network # Documents # -# $Id: londocs.pm,v 1.316 2008/11/18 19:14:22 jms Exp $ +# $Id: londocs.pm,v 1.722 2025/01/07 21:01:37 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -26,22 +26,6 @@ # http://www.lon-capa.org/ # - -=head1 NAME - -Apache::londocs.pm - -=head1 SYNOPSIS - -This is part of the LearningOnline Network with CAPA project -described at http://www.lon-capa.org. - -=head1 SUBROUTINES - -=over - -=cut - package Apache::londocs; use strict; @@ -49,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; @@ -68,28 +65,11 @@ my $hashtied; my %alreadyseen=(); my $hadchanges; +my $suppchanges; -=pod - -=item %help=() - - Available help topics - -=cut - my %help=(); -=pod - -=item mapread() - -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 - -=cut sub mapread { my ($coursenum,$coursedom,$map)=@_; @@ -99,37 +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); } -=pod - -=item authorhosts() - - Return hash with valid author names - -=cut 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'}; @@ -138,857 +120,1566 @@ 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); } -=pod - -=item dumpbutton() - Generate "dump" button - -=cut - -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; } -=pod - -=item dumpcourse() - - Actually dump course +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; + } +} -=cut +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; +} 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').'

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

'); - } -} - -=pod - -=item exportbutton() - - Generate "export" button - -=cut - -sub exportbutton { - my $type = &Apache::loncommon::course_type(); - return '
'. - ''. - &Apache::loncommon::help_open_topic('Docs_Export_Course_Docs').'
'; -} - -=pod - -=item exportcourse() - -=cut - -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 .= &mt('The following errors occurred during export - [_1]',$copyresult); - } - } else { - $outcome = '
'.&mt('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,%newresfile); + $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 '')) { + my $ressrc = $docroot.$resurl.'/'.$file; + my $ressrcmeta = $ressrc.'.meta'; + my ($ext) = ($file =~ /\.(\w+)$/); + my $embstyle=&Apache::loncommon::fileembstyle($ext); + my ($getres,$getresmeta); + if ($respublish) { + if ($path eq '') { + if ((ref($resfiles{'/'}) eq 'HASH') && + (exists($resfiles{'/'}{$fname}))) { + $getres = 1; + $getresmeta = 1; + } + } elsif ((ref($resfiles{$path}) eq 'HASH') && + (exists($resfiles{$path}{$fname}))) { + $getres = 1; + $getresmeta = 1; + } + } + if ($is_course_home) { + my ($needpriv,$needprivmeta); + if ($respublish) { + if ($getres) { + if (&Apache::londiff::are_different_files($src,$ressrc)) { + $needpriv = 1; + if (&File::Copy::copy($ressrc,$dest)) { + if ($embstyle eq 'ssi') { + &crsres_fixup($dest,$coursenum,$coursedom,$ca,$cd); + } + } + } else { + if (&File::Copy::copy($src,$dest)) { + $newfile{$file} = $desturl.'/'.$subdir.'/'.$file; + if ($embstyle eq 'ssi') { + &crsres_fixup($dest,$coursenum,$coursedom,$ca,$cd,$subdir); + } + } + } + } else { + $needpriv = 1; + } + if ($getresmeta) { + if ((-e $src.'.meta') && (!-e $dest.'.meta')) { + if (&Apache::londiff::are_different_files($src.'.meta',$ressrc.'.meta')) { + if (&File::Copy::copy($ressrc.'.meta',$dest.'.meta')) { + &crsres_fixup_meta($dest,$coursenum,$coursedom,$ca,$cd,$copyright, + $customdistfile,$sourceavail,\%checkdeps); + } + $needprivmeta = 1; + } else { + if (&File::Copy::copy($src.'.meta',$dest.'.meta')) { + &crsres_fixup_meta($dest,$coursenum,$coursedom,$ca,$cd,$copyright, + $customdistfile,$sourceavail,\%checkdeps); + } + } + } + } + if ($getres) { + my $destresfile = $docroot.$destresurl.'/'.$subdir.'/'.$file; + if (-e $dest) { + my $output = &Apache::lonpublisher::batchpublish($r,$dest,$destresfile,$nokeyref,1); + if (-e $destresfile) { + $newresfile{$file} = $destresurl.'/'.$subdir.'/'.$file; + } + } + } + } else { + $needpriv = 1; + if ((-e $src.'.meta') && (!-e $dest.'.meta')) { + $needprivmeta = 1; + } + } + if ($needpriv) { + if (&File::Copy::copy($src,$dest)) { + $newfile{$file} = $desturl.'/'.$subdir.'/'.$file; + if ($embstyle eq 'ssi') { + &crsres_fixup($dest,$coursenum,$coursedom,$ca,$cd,$subdir); + } + } + } + if ($needprivmeta) { + if (&File::Copy::copy($src.'.meta',$dest.'.meta')) { + &crsres_fixup_meta($dest,$coursenum,$coursedom,$ca,$cd,$copyright, + $customdistfile,$sourceavail,\%checkdeps); + } + } + } else { + my ($needpriv,$needprivmeta); + if ($respublish) { + if ($getres) { + &Apache::lonnet::repcopy($docroot.$resurl.'/'.$file); + } + if ($getresmeta) { + &Apache::lonnet::repcopy($docroot.$resurl.'/'.$file.'.meta'); + } + if (-e $docroot.$resurl.'/'.$file) { + if (&Apache::lonnet::repcopy_crsprivfile($srcurl.'/'.$file,$dest) eq 'ok') { + if (&Apache::londiff::are_different_files($docroot.$resurl.'/'.$file,$dest)) { + $needpriv = 1; + if (&File::Copy::copy($docroot.$resurl.'/'.$file,$dest)) { + if ($embstyle eq 'ssi') { + &crsres_fixup($dest,$coursenum,$coursedom,$ca,$cd); + } + } + } else { + if ($embstyle eq 'ssi') { + &crsres_fixup($dest,$coursenum,$coursedom,$ca,$cd,$subdir); + } + $newfile{$file} = $desturl.'/'.$subdir.'/'.$file; + } + } + } else { + $needpriv = 1; + } + if (-e $docroot.$resurl.'/'.$file.'.meta') { + if (&Apache::lonnet::repcopy_crsprivfile($srcurl.'/'.$file.'.meta',$dest.'.meta') eq 'ok') { + if (&Apache::londiff::are_different_files($docroot.$resurl.'/'.$file.'.meta',$dest.'.meta')) { + $needprivmeta = 1; + if (&File::Copy::copy($docroot.$resurl.'/'.$file.'.meta',$dest.'.meta')) { + &crsres_fixup_meta($dest,$coursenum,$coursedom,$ca,$cd,$copyright, + $customdistfile,$sourceavail,\%checkdeps); + } + } else { + &crsres_fixup_meta($dest,$coursenum,$coursedom,$ca,$cd,$copyright, + $customdistfile,$sourceavail,\%checkdeps); + } + } + } else { + if (!-e $dest.'.meta') { + $needprivmeta = 1; + } + } + if ($getres) { + my $destresfile = $docroot.$destresurl.'/'.$subdir.'/'.$file; + if (-e $dest) { + my $output = &Apache::lonpublisher::batchpublish($r,$dest,$destresfile,$nokeyref,1); + if (-e $destresfile) { + $newresfile{$file} = $destresurl.'/'.$subdir.'/'.$file; + } + } + } + } else { + $needpriv = 1; + if (!-e $dest.'.meta') { + $needprivmeta = 1; + } + } + if ($needpriv) { + if (&Apache::lonnet::repcopy_crsprivfile($srcurl.'/'.$file,$dest) eq 'ok') { + if ($embstyle eq 'ssi') { + &crsres_fixup($dest,$coursenum,$coursedom,$ca,$cd,$subdir); + } + $newfile{$file} = $desturl.'/'.$subdir.'/'.$file; + } + } + if ($needprivmeta) { + if (&Apache::lonnet::repcopy_crsprivfile($srcurl.'/'.$file.'.meta',$dest.'.meta') eq 'ok') { + &crsres_fixup_meta($dest,$coursenum,$coursedom,$ca,$cd,$copyright, + $customdistfile,$sourceavail,\%checkdeps); + } + } + } + } + } + } else { + $notopdir = 1; + } + } + if ($notopdir) { + $r->print('

    '.&mt('No files or sub-directories copied').'
    '."\n". + ''.&mt('Target directory: [_1] does not exist, and could not be created.', + ''.$desturl.'/'.$subdir.''). + '

    '."\n"); + } + if (keys(%newdir)) { + $r->print('

    '.&mt('Created the following directories in [_1]:',''.$desturl.'/'.$subdir.''). + '

    '."\n". + '

    '."\n"); + } + if (keys(%newfile)) { + $r->print('

    '.&mt('Copied the following files to [_1]:',''.$desturl.'/'.$subdir.''). + '

    '."\n". + '

    '."\n"); + foreach my $file (keys(%newfile)) { + my %storehash = ( + 'priv' => $newfile{$file}, + 'who' => $env{'user.name'}.':'.$env{'user.domain'}, + ); + if (exists($newresfile{$file})) { + $storehash{'res'} = 1; + } + &Apache::lonnet::store_userdata(\%storehash,$file,'copycourseauthor',$coursedom,$coursenum); + } + } + if (keys(%checkdeps)) { + my %missingdep; + foreach my $depfile (sort(keys(%checkdeps))) { + unless (-e "$desttop/$depfile") { + $missingdep{$depfile} = 1; + } + } + if (keys(%missingdep)) { + $r->print('

    '.&mt('You may also need to copy the following missing dependencies for files copied to [_1]:', + ''.$desturl.'/'.$subdir.''). + '

    '."\n". + '

    '."\n"); + } } - close($copiedfile); } else { - $$message = 'Could not open destination file for '.$filename."
    \n"; + $r->print('

    '.&mt('No currently existing files or directories in Course Authoring Space selected for copying').'

    '); + $r->print(&endContentScreen()); + return ''; } } 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,\%allfiles,\%codebase,$content); - foreach my $embed_file (keys(%allfiles)) { - my $filename; - if ($embed_file =~ m#([^/]+)$#) { - $filename = $1; - } 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 + my $chkname = 'copytouser'; + my $context = 'crsauthored'; + my (%subdirs,%files,@dirs_by_depth,@files_by_depth,%parent,%children,%hierarchy,@checked_maps); + &Apache::lonnet::recursedirs($is_course_home,1,undef,$exclude,0,0,$srcurl,'',\%subdirs,\%files,1); + foreach my $key (keys(%subdirs)) { + next if (($key eq '/') || ($key eq '')); + my @items = split(/\//,$key); + my $dir = pop(@items); + my $depth = scalar(@items); + my $path; + if (!$depth) { + $path = '/'; } 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'; + $path = join('/',@items); } - } elsif ($caller eq 'uploaded') { - - $repstatus = &Apache::lonnet::getuploaded('GET',$embed_url,$cdom,$cnum,\$embed_content,$rtncode); + $dirs_by_depth[$depth]{$path}{$dir} = 1; } - if ($repstatus eq 'ok') { - my $destination = $tempexport.'/resources/'.$count.'/res'; - if (!-e "$destination") { - mkdir($destination,0755); + foreach my $path (keys(%files)) { + next if ($path eq ''); + my $depth; + if ($path eq '/') { + $depth = 0; + } else { + $depth = scalar(split(/\//,$path)); } - $destination .= '/'.$filename; - my $copiedfile; - if ($copiedfile = Apache::File->new('>'.$destination)) { - print $copiedfile $embed_content; - push @{$href}, 'resources/'.$count.'/res/'.$filename; - my $attrib_regexp = ''; - if (@{$allfiles{$embed_file}} > 1) { - $attrib_regexp = join('|',@{$allfiles{$embed_file}}); - } else { - $attrib_regexp = $allfiles{$embed_file}[0]; + if (ref($files{$path}) eq 'HASH') { + foreach my $file (keys(%{$files{$path}})) { + $files_by_depth[$depth]{$path}{$file} = $files{$path}{$file}; } - $$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; + } + } + my ($info,$display,$onsubmit,$togglebuttons,$disabled); + my (%resdirs,%resfiles); + &Apache::lonnet::recursedirs($is_course_home,1,undef,$res_exclude,0,0,$resurl,'',\%resdirs,\%resfiles); + my $numpub = 0; + if (keys(%resfiles)) { + foreach my $dir (keys(%resfiles)) { + if (ref($resfiles{$dir}) eq 'HASH') { + foreach my $file (keys(%{$resfiles{$dir}})) { + if (exists($files{$dir}{$file})) { + $numpub ++; + } + } } } + } + if ($readonly) { + $disabled = ' disabled="disabled"'; + } + if ($disabled) { + $togglebuttons = '
    '; } else { - $$message .= 'replication of embedded file - '.$embed_file.' in '.$url.' failed, reason -'.$rtncode."
    \n"; + $togglebuttons = ''. + '  '; + } + my $preamble = &authorspace_selector($r,$formname,$home,$title,%outhash). + &courseresource_options($formname,$numpub). + '
    '."\n"; + my $display = '
    '."\n". + $preamble."\n". + '
    '."\n". + '
    '."\n". + ''.&mt('Content to copy').(' 'x4).$togglebuttons.''."\n". + ''. + &mt('Choose the files and/or folders to copy from Course Authoring to User Authoring'). + '

    '."\n"; + my $count = 0; +# +# Warning to developers: +# +# If you add or remove form elements which precede the table of items to copy +# you will need to modify the value for startcount. Form elements include both: +# and
    tags. +# $startcount (set to 9) contains the following: +# fieldsets with following legends: (a) Folder in Authoring Space, (b) Distribution to set in metadata +# (c) Content to copy +# inputs: textbox for destination folder; dropdown lists: (a) Copyright, (b) Source +# hidden: customrights file; buttons: (a) check all, (b) uncheck all. +# authorspace: if more than 1: a fieldset with legend: Select the Authoring Space, +# or if 1: an input (hidden) with available author/coauthor role. +# if there are multiple possible author/coauthor roles (i.e., $home > 1), +# incerement startcount by 1 for the dropdown list uses to select the target. +# +# If there are published files, increment startcount by 3: +# fieldset (legend: Published Resources), and two radio buttons (Yes/No). +# + my $startcount = 9; + if ($home > 1) { + $startcount ++; } - } - return; -} - -sub store_template { - my ($contents,$tempexport,$count,$content_type) = @_; - if ($contents) { - if ($tempexport) { - if (!-e $tempexport.'/resources') { - mkdir($tempexport.'/resources',0700); + if ($numpub) { + $startcount += 3; + } + my $lastcontainer = $startcount; + $display .= &Apache::loncommon::start_data_table()."\n". + &Apache::loncommon::start_data_table_header_row(). + ''.&mt('Copy?').''. + ''.&mt('Name').''. + ''.&mt('Last modified').''. + ''.&mt('Published?').''. + &Apache::loncommon::end_data_table_header_row()."\n"; + $count = &recurse_crsauthored(0,\@dirs_by_depth,\@files_by_depth,'/',$startcount, + $count,\$display,\%parent,\%children,$readonly, + $formname,$chkname,\$lastcontainer,\%resfiles); + $display .= &Apache::loncommon::end_data_table().'
    '; + unless ($readonly) { + $display .= '
    '. + '
    '. + ''. + '
    '; + } + $display .= &Apache::loncourserespicker::respicker_javascript($startcount,$count,$context,$formname,\%children, + \%hierarchy,\@checked_maps,$home,$chkname); + $r->print($display); + } + $r->print(&endContentScreen()); +} + +sub recurse_crsauthored { + my ($currdepth,$dirs_by_depth,$files_by_depth,$currpath,$startcount,$count,$displayref, + $parent,$children,$readonly,$formname,$chkname,$lastcontainerref,$resfilesref) = @_; + return $count unless ((ref($dirs_by_depth) eq 'ARRAY') && (ref($files_by_depth) eq 'ARRAY') && + (ref($resfilesref) eq 'HASH')); + my ($disabled,$hasdirs,$hasfiles,%unique,%dirs,%files); + if ((ref($dirs_by_depth->[$currdepth]) eq 'HASH') && + (ref($dirs_by_depth->[$currdepth]{$currpath}) eq 'HASH')) { + $hasdirs = 1; + %dirs = %{$dirs_by_depth->[$currdepth]{$currpath}}; + map { $unique{$_} = 1; } keys(%dirs); + } + if ((ref($files_by_depth->[$currdepth]) eq 'HASH') && + (ref($files_by_depth->[$currdepth]{$currpath}) eq 'HASH')) { + $hasfiles = 1; + %files = %{$files_by_depth->[$currdepth]{$currpath}}; + map { $unique{$_} = 1; } keys(%files); + } + if ($readonly) { + $disabled = ' disabled="disabled"'; + } + my $location=&Apache::loncommon::lonhttpdurl("/adm/lonIcons"); + my $whitespace = + ''; + $parent->{$currdepth} = $$lastcontainerref; + foreach my $item (sort { lc($a) cmp lc($b) } (keys(%unique))) { + next if ($item eq ''); + my $currelem; + if ($hasdirs && exists($dirs{$item})) { + $count ++; + my $deeper = $currdepth+1; + my ($newpath,$showpath); + if ($currpath eq '/') { + $newpath = $item; + $showpath = $currpath.$item.'/'; + } else { + $newpath = $currpath.'/'.$item; + $showpath = '/'.$currpath.'/'.$item.'/'; } - if (!-e $tempexport.'/resources/'.$count) { - mkdir($tempexport.'/resources/'.$count,0700); + $currelem = $count+$startcount; + $$lastcontainerref = $currelem; + $children->{$parent->{$currdepth}} .= $currelem.':'; + my $icon = 'src="'.$location.'/navmap.folder.open.gif" alt="'.&mt('Folder').'"'; + $$displayref .= &Apache::loncommon::start_data_table_row(). + ''; + for (my $i=0; $i<$currdepth; $i++) { + $$displayref .= "$whitespace\n"; } - my $destination = $tempexport.'/resources/'.$count.'/'.$content_type.'.xml'; - my $storetemplate; - if ($storetemplate = Apache::File->new('>'.$destination)) { - print $storetemplate $contents; - close($storetemplate); + $$displayref .= ' '.$item.'  '. + &Apache::loncommon::end_data_table_row()."\n"; + $count = &recurse_crsauthored($deeper,$dirs_by_depth,$files_by_depth,$newpath, + $startcount,$count,$displayref,$parent,$children, + $readonly,$formname,$chkname,$lastcontainerref,$resfilesref); + } + if ($hasfiles && exists($files{$item})) { + $count ++; + $currelem = $count+$startcount; + $children->{$parent->{$currdepth}} .= $currelem.':'; + my $icon = 'src="'.&Apache::loncommon::icon($item).'"'; + my ($ext) = ($item =~ /\.([^.]+)$/); + my $alttext; + if (lc($ext) eq 'problem') { + $alttext = ' alt="'.&mt('Problem Icon').'"'; + } elsif ($ext =~ /^x?html?$/i) { + $alttext = ' alt="'.&mt('Web Page Icon').'"'; + } elsif ($ext =~ /^(jpg|gif|png|svg|jpeg)$/) { + $alttext = ' alt="'.&mt('Image Icon').'"'; + } else { + $alttext = ' alt="'.&mt('Resource Icon').'"'; + } + my $showpath; + if ($currpath eq '/') { + $showpath = $currpath; + } else { + $showpath = "/$currpath/"; } - if ($content_type eq 'external') { - return 'resources/'.$count.'/'.$content_type.'.html'; + my ($published,$lastmod); + if ((ref($resfilesref->{$currpath})) && (exists($resfilesref->{$currpath}{$item}))) { + $published = ''.&mt('yes').''; } else { - return 'resources/'.$count.'/'.$content_type.'.xml'; + $published = ''.&mt('no').''; + } + $$displayref .= &Apache::loncommon::start_data_table_row(). + ''; + for (my $i=0; $i<$currdepth; $i++) { + $$displayref .= "$whitespace\n"; } + $$displayref .= ' '.$item.''. + ''.&Apache::lonlocal::locallocaltime($files{$item}).''. + ''.$published.''. + &Apache::loncommon::end_data_table_row()."\n"; } } + $$lastcontainerref = $parent->{$currdepth}; + return $count; } -=pod - -=item group_import() - - Imports the given (name, url) resources into the course - coursenum, coursedom, and folder must precede the list +sub courseresource_options { + my ($formname,$numpub) = @_; + my %lt = &Apache::lonlocal::texthash( + 'default' => 'System wide - can be used for any courses system wide', + 'domain' => 'Domain only - use limited to courses in the domain', + 'custom' => 'Customized right of use ...', + 'public' => 'Public - no authentication or authorization required for use', + 'closed' => 'Closed - XML source is closed to everyone', + 'open' => 'Open - XML source is open to people who want to use it', + 'sel' => 'Select', + ); + my $output; + if ($numpub) { + $output .= '
    '. + '
    '.&mt('Published Resources').''. + &mt('[quant,_1,file] in Course Authoring Space also exist in Resource Space.', + $numpub).'
    '. + &mt('Publish copied files in selected Authoring Space?').': '."\n". + ''."\n". + ''."\n". + '
    '."\n"; + } + $output .= '
    '. + '
    '.&mt('Distribution to set in metadata').''. + &mt('Copyright').': '. + '
    '."\n". + &mt('Source').' :'. + '
    '."\n". + '
    '."\n"; + return $output; +} + +sub crsres_fixup_meta { + my ($dest,$coursenum,$coursedom,$ca,$cd,$copyright,$customdistfile,$sourceavail,$checkdeps) = @_; + return unless (ref($checkdeps) eq 'HASH'); + if (open(my $fh,'<',$dest.'.meta')) { + my ($output,$now,$setsourceavail); + $now = time; + if (($dest =~ /\.(xml|html|htm|xhtml|xhtm)$/i) || ($dest =~ /$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); + } + } +} -=cut +sub crsres_fixup { + my ($dest,$coursenum,$coursedom,$ca,$cd,$subdir) = @_; + 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