--- loncom/interface/londocs.pm 2004/09/18 17:03:25 1.144 +++ 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.144 2004/09/18 17:03:25 albertel Exp $ +# $Id: londocs.pm,v 1.722 2025/01/07 21:01:37 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -30,17 +30,32 @@ package Apache::londocs; use strict; use Apache::Constants qw(:common :http); +use Apache::imsexport; use Apache::lonnet; use Apache::loncommon; -use Apache::lonratedt; -use Apache::lonratsrv; +use Apache::lonhtmlcommon; +use LONCAPA::map(); +use Apache::lonratedt(); use Apache::lonxml; -use Apache::loncreatecourse; +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; @@ -50,673 +65,1621 @@ my $hashtied; my %alreadyseen=(); my $hadchanges; +my $suppchanges; -# Available help topics my %help=(); -# Mapread read maps into lonratedt::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)=@_; return - &Apache::lonratedt::mapread('/uploaded/'.$coursedom.'/'.$coursenum.'/'. - $map); + &LONCAPA::map::mapread('/uploaded/'.$coursedom.'/'.$coursenum.'/'. + $map); } sub storemap { - my ($coursenum,$coursedom,$map)=@_; + my ($coursenum,$coursedom,$map,$contentchg)=@_; + my $report; + if (($contentchg) && ($map =~ /^default/)) { + $report = 1; + } my ($outtext,$errtext)= - &Apache::lonratedt::storemap('/uploaded/'.$coursedom.'/'.$coursenum.'/'. - $map,1); + &LONCAPA::map::storemap('/uploaded/'.$coursedom.'/'.$coursenum.'/'. + $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'}; + $ca=$env{'user.name'}; + $cd=$env{'user.domain'}; } else { - ($cd,$ca)=($realm=~/^\/(\w+)\/(\w+)$/); + ($cd,$ca)=($realm=~/^\/($match_domain)\/($match_username)$/); } 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(); - if ($home+$other==0) { return ''; } - my $output=''; - if ($home) { - return ''. - ''. - &Apache::loncommon::help_open_topic('Docs_Dump_Course_Docs'); + +sub clean { + my ($title)=@_; + $title=~s/[^\w\/\!\$\%\^\*\-\_\=\+\;\:\,\\\|\`\~]+/\_/gs; + 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''. - &mt('Dump Course DOCS to Construction Space: available on other servers'); + return $folderpath; } } -# -------------------------------------------------------- Actually dump course +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=shift; - $r->print('Dump DOCS'. - &Apache::loncommon::bodytag('Dump Course DOCS to Construction Space'). - '
'); + my ($r) = @_; + 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 ''; } - my $origcrsid=$ENV{'request.course.id'}; + 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/)) { + 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=~s/[^\w\/]+/\_/g; - my %replacehash=(); - foreach (keys %ENV) { - if ($_=~/^form\.namefor\_(.+)/) { - $replacehash{$1}=$ENV{$_}; - } + my $title=$env{'form.authorfolder'}; + $title=&clean($title); + 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 $crs='/uploaded/'.$ENV{'request.course.id'}.'/'; + 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\/\.\/]+/\_/g; - 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::loncreatecourse::rewritefile( - &Apache::loncreatecourse::readfile($ENV{'request.course.id'},$_), - (%replacehash,$crs => '') - ); - } else { - print $fh - &Apache::loncreatecourse::readfile($ENV{'request.course.id'},$_); - } - $fh->close(); - } else { - $fail=1; - } - if ($fail) { - $r->print('fail'); - } else { - $r->print('ok'); - } - } + 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; + } + } + 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); + } + } + foreach my $num (sort {$a <=> $b} (@todump)) { + my $src = $display{$num}; + next if ($src eq ''); + my @needcopy = (); + if ($replacehash{$src}) { + push(@needcopy,$src); + if (ref($deps{$num}) eq 'HASH') { + foreach my $dep (sort(keys(%{$deps{$num}}))) { + if ($replacehash{$dep}) { + push(@needcopy,$dep); + } + } + } + } elsif ($src =~ /^simpleproblem_/) { + push(@needcopy,$src); + } + 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}; + } + $newfilename=~s/\.(\w+)$//; + my $ext=$1; + $newfilename=&clean($newfilename); + $newfilename.='.'.$ext; + my ($newrelpath) = ($newfilename =~ m{^\Q$title/\E(.+)$}); + if ($newrelpath ne $replacehash{$item}) { + $replacehash{$item} = $newrelpath; + } + my @dirs=split(/\//,$newfilename); + my $path=$r->dir_config('lonDocRoot')."/priv/$cd/$ca"; + my $makepath=$path; + my $fail; + my $origin; + for (my $i=0;$i<$#dirs;$i++) { + $makepath.='/'.$dirs[$i]; + unless (-e $makepath) { + unless(mkdir($makepath,0755)) { + $fail = &mt('Directory creation failed.'); + } + } + } + if ($i == 0) { + $result = '
'.$item.' => '.$newfilename.': '; + } else { + $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(''); + } + } } else { -# Input form - unless ($home==1) { - $r->print( - '

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

    '); - } else { - $r->print(''); - } + my ($navmap,$errormsg) = + &Apache::loncourserespicker::get_navmap_object($crstype,'dumpdocs'); + if (!ref($navmap)) { + $r->print($errormsg); + } else { + my $title=$origcrsdata{'description'}; + $title=~s/[\/\s]+/\_/gs; + $title=&clean($title); + my $formname = 'dumpdoc'; + my $preamble = &authorspace_selector($r,$formname,$home,$title,%outhash). + '
    '."\n"; + my %uploadedfiles; + &tiehash(); + foreach my $file (&Apache::lonclonecourse::crsdirlist($origcrsid,'userfiles')) { + my ($ext)=($file=~/\.(\w+)$/); +# FIXME Check supplemental here + my $title=$hash{'title_'.$hash{ + 'ids_/uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'.$file}}; + if (!$title) { + $title=$file; + } else { + $title=~s|/|_|g; + } + $title=~s/\.(\w+)$//; + $title=&clean($title); + $title.='.'.$ext; +# $r->print("\n" + $uploadedfiles{$file} = $title; } - } - unless ($home==1) { - $r->print(''); - } - my $title=$origcrsdata{'description'}; - $title=~s/\s+/\_/gs; - $title=~s/\W//gs; - $r->print('

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


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

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

    '); - foreach (&Apache::loncreatecourse::crsdirlist($origcrsid,'userfiles')) { - $r->print(''); - my ($ext)=($_=~/\.(\w+)$/); - my $title=$hash{'title_'.$hash{ - 'ids_/uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'.$_}}; - $r->print(''); - unless ($title) { - $title=$_; - } - $title=~s/\.(\w+)$//; - $title=~s/[^\w\/]+/\_/gs; - $title.='.'.$ext; - $r->print("\n\n"); - } - $r->print("
    '.&mt('Internal Filename').''.&mt('Title').''.&mt('Save as ...').'
    '.$_.''.($title?$title:' ').'
    \n"); - &untiehash(); - $r->print( - '

    '); + &untiehash(); + $r->print(&Apache::loncourserespicker::create_picker($navmap,'dumpdocs',$formname,$crstype,undef, + undef,undef,$preamble,$home,\%uploadedfiles)); + } } + $r->print(&endContentScreen()); } -# ------------------------------------------------------ Generate "export" button - -sub exportbutton { - return ''. - ''. - &Apache::loncommon::help_open_topic('Docs_Export_Course_Docs'); +sub authorspace_selector { + my ($r,$formname,$home,$title,%outhash) = @_; + $r->print('
    '.&mt('Searching ...').'
    '."\n"); + $r->rflush(); + my $preamble; + unless ($home==1) { + $preamble = '
    '. + '
    '. + &mt('Select the Authoring Space'). + ''; + } else { + $preamble .= ''; + } + } + unless ($home==1) { + $preamble .= '
    '."\n"; + } + $preamble .= '
    '. + '
    '.&mt('Folder in Authoring Space').''. + ''."\n". + '
    '."\n"; + return $preamble; } -sub exportcourse { - my $r=shift; - 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 = (); - if (defined($ENV{'form.archive'})) { - if (ref($ENV{'form.archive'}) eq 'ARRAY') { - @exportitems = @{$ENV{'form.archive'}}; - } else { - $exportitems[0] = $ENV{'form.archive'}; - } - } - my @discussions = (); - if (defined($ENV{'form.discussion'})) { - if (ref($ENV{'form.discussion'}) eq 'ARRAY') { - @discussions = $ENV{'form.discussion'}; - } else { - $discussions[0] = $ENV{'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 $count = 0; - 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'; -# zip can cause an sh launch which can pass along all of %ENV -# which can be too large for /bin/sh to handle - my %oldENV=%ENV; - undef(%ENV); - my $cwd = &Cwd::getcwd(); - my $imszip = '/home/httpd/'.$imszipfile; - chdir $tempexport; - open(OUTPUT, "zip -r $imszip * 2> /dev/null |"); - close(OUTPUT); - chdir $cwd; - %ENV=%oldENV; - undef(%oldENV); - $outcome .= 'Download the zip file from IMS course archive
    '; - 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('Export Course'. - &Apache::loncommon::bodytag('Export course to IMS or SCORM content package')); - $r->print($outcome); - $r->print(''); - } else { - my $display; - $display = '
    '."\n"; - $display .= 'Choose which items you wish to export from your course.

    '; - $display .= ''. - ''. - ''. - ''. - '
     Content items'. - ''. - '  
    		  
     Discussion posts'. - ''. - '  
    '; - my $curRes; - my $depth = 0; - my $count = 0; - my $boards = 0; - my $startcount = 5; - my %parent = (); - my %children = (); - my $lastcontainer = $startcount; - my @bgcolors = ('#F6F6F6','#FFFFFF'); - $display .= ''. - ''; - while ($curRes = $it->next()) { - if (ref($curRes)) { - $count ++; - } - if ($curRes == $it->BEGIN_MAP()) { - $depth++; - $parent{$depth} = $lastcontainer; - } - if ($curRes == $it->END_MAP()) { - $depth--; - $lastcontainer = $parent{$depth}; - } - if (ref($curRes)) { - my $symb = $curRes->symb(); - my $color = $count%2; - $display .=''; - if ($discussiontime{$symb} > 0) { - $boards ++; - $currelem = $count+$boards+$startcount; - $display .= ''."\n"; - } else { - $display .= ''."\n"; - } - } - } - my $scripttag = qq| - + +ENDJS + } elsif ($home) { + $js = <<"ENDJS"; + + +ENDJS } + $js .= <<"ENDJS"; + - |; - $r->print('Export Course'.$scripttag.''. - &Apache::loncommon::bodytag('Export course to IMS or SCORM 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"; - } - if ($curRes->is_sequence()) { - $display .= ' '."\n"; - $lastcontainer = $count + $startcount + $boards; - } elsif ($curRes->is_page()) { - $display .= ' '."\n"; - $lastcontainer = $count + $startcount + $boards; - } - my $currelem = $count+$boards+$startcount; - $children{$parent{$depth}} .= $currelem.':'; - $display .= ' '.$curRes->title().'   
    '. - '

    '. - '

    '); +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 { + 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}); + } + } + } + } 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 { + $notopdir = 1; + } + } + 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"); + } + } + } else { + $r->print('

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

    '); + $r->print(&endContentScreen()); + return ''; + } + } else { + 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 { + $path = join('/',@items); + } + $dirs_by_depth[$depth]{$path}{$dir} = 1; + } + foreach my $path (keys(%files)) { + next if ($path eq ''); + my $depth; + if ($path eq '/') { + $depth = 0; + } else { + $depth = scalar(split(/\//,$path)); + } + if (ref($files{$path}) eq 'HASH') { + foreach my $file (keys(%{$files{$path}})) { + $files_by_depth[$depth]{$path}{$file} = $files{$path}{$file}; + } + } + } + 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 { + $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 ++; + } + 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 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); - } -# 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". -' '."\n". -' '."\n". -' '.$ENV{'request.'.$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{'request.'.$ENV{'request.course.id'}.'.num'}; - my $cdom = $ENV{'request.'.$ENV{'request.course.id'}.'.domain'}; - while ($curRes = $it->next()) { - if (ref($curRes)) { +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.'/'; + } + $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"; + } + $$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 ($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; - if ($curRes == $it->BEGIN_MAP()) { - $prevdepth = $depth; - $depth++; - } - if ($curRes == $it->END_MAP()) { - $prevdepth = $depth; - $depth--; - } - - if (ref($curRes)) { - 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.'"'; - } - if (($depth <= $prevdepth) && ($count > 1)) { - print $ims_manifest ' '."\n"; - } - $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"; - } - $imsresources .= ' '."\n"; - } - } - $pkgdepth = $depth; - } - } - while ($pkgdepth > -1) { - 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) { - unless (grep/^$$parent{$depth}$/,@$exportitems || grep/^$$parent{$depth}$/,@$dependencies) { - push @$dependencies, $$parent{$depth}; - if ($depth > 2) { - &get_dependencies($exportitems,$parent,$depth-1,$dependencies); + 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/"; + } + my ($published,$lastmod); + if ((ref($resfilesref->{$currpath})) && (exists($resfilesref->{$currpath}{$item}))) { + $published = ''.&mt('yes').''; + } else { + $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; } -sub process_content { - my ($count,$curRes,$cdom,$cnum,$symb,$content_file,$href,$copyresult,$tempexport) = @_; - my $content_type; - my $message; -# find where user is author or co-author - my %roleshash = &Appache::lonnet::get_my_roles(); - if ($curRes->is_page()) { - $content_type = 'page'; - } elsif ($symb =~ m-public/$cdom/$cnum/syllabus$-) { - $content_type = 'syllabus'; - } elsif ($symb =~ m-\.sequence____\d+____ext-) { - $content_type = 'external'; - } elsif ($symb =~ m-adm/navmaps$-) { - $content_type = 'navmap'; - } elsif ($symb =~ m-adm/$cdom/$cnum/\d+/smppg$-) { - $content_type = 'simplepage'; - } elsif ($symb =~ m-$-) { - $content_type = 'simpleproblem'; - } elsif ($symb =~ m-adm/$cdom/$cnum/\d+/bulletinboard$-) { - $content_type = 'bulletinboard'; - } elsif ($symb =~ m-adm/$cdom/$cnum/\d+/aboutme$-) { - $content_type = 'aboutme'; - } elsif ($symb =~ m-uploaded/$cdom/$cnum-) { - &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,'uploaded'); - } elsif ($symb =~ m-\.sequence____\d+____([^/])/([^/])-) { - my $coauth = $2.':'.$1.':ca'; - my $canedit = 0; - if ($1 eq $ENV{'user.domain'} && $2 eq $ENV{'user.name'}) { - $canedit= 1; - } elsif (defined($roleshash{$coauth})) { - if ($roleshash{$coauth} =~ /(\d+):(\d+)/) { - if (($1 < time || $1 == 0) && ($2 == 0 || $2 >= time)) { - $canedit = 1; +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 ($roleshash{$coauth} eq ':') { - $canedit = 1; + } 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"; } } - if ($canedit) { - &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,'resource'); - } else { - &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,'noedit'); + close($fh); + if (open(my $fh,'>',$dest.'.meta')) { + print $fh $output; + close($fh); } } - $$copyresult .= $message."\n"; } -sub replicate_content { - my ($cdom,$cnum,$tempexport,$symb,$count,$message,$caller) = @_; - my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); - my $feedurl = &Apache::lonnet::clutter($url); - - my $content; - my $filename; - my $repstatus; - if ($url =~ m-[^/]/(.+)$-) { - $filename = $1; - if (!-e $tempexport.'/resources') { - mkdir($tempexport.'/resources',0700); - } - if (!-e $tempexport.'/resources') { - mkdir($tempexport.'/resources/'.$count,0700); - } - my $destination = $$tempexport.'/resources/'.$count.'/'.$filename; - my $copiedfile; - if ($copiedfile = Apache::File->new('>'.$destination)) { - my $content; - if ($caller eq 'uploaded' || $caller eq 'resource') { - $content = &Apache::lonnet::getfile($url); - if ($content eq -1) { - $$message = 'Could not copy file '.$filename; - } else { - $repstatus = 'ok'; +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