--- loncom/interface/londocs.pm 2009/06/09 18:42:42 1.371
+++ loncom/interface/londocs.pm 2024/12/20 15:15:04 1.712
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Documents
#
-# $Id: londocs.pm,v 1.371 2009/06/09 18:42:42 tempelho Exp $
+# $Id: londocs.pm,v 1.712 2024/12/20 15:15:04 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -26,8 +26,6 @@
# http://www.lon-capa.org/
#
-
-
package Apache::londocs;
use strict;
@@ -35,15 +33,27 @@ use Apache::Constants qw(:common :http);
use Apache::imsexport;
use Apache::lonnet;
use Apache::loncommon;
+use Apache::lonhtmlcommon;
use LONCAPA::map();
use Apache::lonratedt();
use Apache::lonxml;
use Apache::lonclonecourse;
use Apache::lonnavmaps;
+use Apache::lonnavdisplay();
+use Apache::lonextresedit();
+use Apache::lontemplate();
+use Apache::lonsimplepage();
+use Apache::lonhomework();
+use Apache::lonpublisher();
+use Apache::loncourserespicker();
use HTML::Entities;
+use HTML::TokeParser;
use GDBM_File;
+use File::MMagic;
+use File::Copy;
use Apache::lonlocal;
use Cwd;
+use UUID::Tiny ':std';
use LONCAPA qw(:DEFAULT :match);
my $iconpath;
@@ -54,6 +64,7 @@ my $hashtied;
my %alreadyseen=();
my $hadchanges;
+my $suppchanges;
my %help=();
@@ -67,13 +78,21 @@ 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);
}
@@ -83,6 +102,7 @@ sub authorhosts {
my %outhash=();
my $home=0;
my $other=0;
+ my @ids=&Apache::lonnet::current_machine_ids();
foreach my $key (keys(%env)) {
if ($key=~/^user\.role\.(au|ca)\.(.+)$/) {
my $role=$1;
@@ -99,13 +119,17 @@ 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++;
}
}
@@ -114,830 +138,980 @@ sub authorhosts {
}
-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;
}
-
-
-sub dumpcourse {
- my ($r) = @_;
- my $type = &Apache::loncommon::course_type();
- $r->print(&Apache::loncommon::start_page('Dump '.$type.' DOCS to Construction Space').
- '');
+ return $folderpath;
}
}
-
-
-sub exportbutton {
- my $type = &Apache::loncommon::course_type();
- return ''.
- &Apache::loncommon::help_open_topic('Docs_Export_Course_Docs').' ';
-}
-
-
-
-sub exportcourse {
- my $r=shift;
- my $type = &Apache::loncommon::course_type();
- my %discussiontime = &Apache::lonnet::dump('discussiontimes',
- $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'});
- my $numdisc = keys(%discussiontime);
- my $navmap = Apache::lonnavmaps::navmap->new();
- if (!defined($navmap)) {
- $r->print(&Apache::loncommon::start_page('Export '.lc($type).' to IMS content package').
- '
IMS Export Failed
'.
- '
'.
- &mt('Unable to retrieve information about course contents').
- '
'.&mt('Return to Course Editor').'');
- &Apache::lonnet::logthis('IMS export failed - could not create navmap object in '.lc($type).':'.$env{'request.course.id'});
- return;
- }
- 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 [_1]IMS '.lc($type).' archive[_2]'
- ,'','')
- .'
';
- 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 = '');
- }
-}
-
-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};
+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) {
+ $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'}}) {
+ $r->print('
'.&mt('Selected Authoring Space is not on this server.').'
'.
+ &endContentScreen());
+ return '';
}
- if (ref($curRes)) {
- if ($curRes->is_sequence() || $curRes->is_page()) {
- $lastcontainer = $count;
- }
- if (grep(/^$count$/,@$exportitems)) {
- &get_dependencies($exportitems,\%parent,$depth,\@dependencies);
+ my ($ca,$cd)=split(/\:/,$env{'form.authorspace'});
+ $r->print('
'.&mt('Copying Files').'
');
+ 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 @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;
}
}
- }
-# 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++;
+ my $crs='/uploaded/'.$env{'request.course.id'}.'/';
+ $crs=~s/\_/\//g;
+ 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} = '';
+ $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".'
'.&mt('Target directory: [_1] name is already in a use for a file -- not overwriting.',
+ ''.$desturl.'/'.$subdir.'/'.$file.'').
+ '
'."\n");
+ } elsif (($src ne '') && ($dest ne '')) {
+ if (&File::Copy::copy($src,$dest)) {
+ $newfile{$file} = 1;
+ if ((-e $src.'.meta') && (!-e $dest.'.meta')) {
+ if (&File::Copy::copy($src.'.meta',$dest.'.meta')) {
+#FIXME set distribution/copyright to author's default instead of custom. set author to $ca:$cd instead of $cdom:$cnum
+ }
+ }
+ my ($ext) = ($file =~ /\.(\w+)$/);
+ my $embstyle=&Apache::loncommon::fileembstyle($ext);
+ if ($embstyle eq 'ssi') {
+#FIXME in any src or href attributes replace /res/$coursedom/$coursenum/ with /res/$cd/$ca/$subdir
+ }
+ }
+ }
+ }
+ } 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".
+ '
'.join('
',sort(keys(%newdir))).'
'."\n");
+ }
+ if (keys(%newfile)) {
+ $r->print('
'.&mt('Copied the following files to [_1]:',''.$desturl.'/'.$subdir.'').
+ '
'."\n".
+ '
'.join('
',sort(keys(%newfile))).'
'."\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 $formname = 'copycrsauthored';
+ my $chkname = 'copytouser';
+ my $context = 'crsauthored';
+ my (%subdirs,%files,@dirs_by_depth,@files_by_depth,%parent,%children,%hierarchy,@checked_maps);
+ &Apache::lonnet::recursedirs($home,1,undef,$exclude,0,0,$srcurl,'',\%subdirs,\%files);
+ 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
+ $path = join('/',@items);
}
+ $dirs_by_depth[$depth]{$path}{$dir} = 1;
}
- 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';
- }
- } elsif ($caller eq 'uploaded') {
-
- $repstatus = &Apache::lonnet::getuploaded('GET',$embed_url,$cdom,$cnum,\$embed_content,$rtncode);
- }
- 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];
- }
- $$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;
+ if (ref($files{$path}) eq 'HASH') {
+ foreach my $file (keys(%{$files{$path}})) {
+ $files_by_depth[$depth]{$path}{$file} = 1;
}
}
- } else {
- $$message .= 'replication of embedded file - '.$embed_file.' in '.$url.' failed, reason -'.$rtncode." \n";
}
- }
- return;
-}
-
-sub store_template {
- my ($contents,$tempexport,$count,$content_type) = @_;
- if ($contents) {
- if ($tempexport) {
- if (!-e $tempexport.'/resources') {
- mkdir($tempexport.'/resources',0700);
+ my ($info,$display,$onsubmit,$togglebuttons,$disabled);
+ if ($readonly) {
+ $disabled = ' disabled="disabled"';
+ }
+ if ($disabled) {
+ $togglebuttons = ' ';
+ } else {
+ $togglebuttons = ''.
+ ' ';
+ }
+ my $title=$origcrsdata{'description'};
+ $title=~s/[\/\s]+/\_/gs;
+ $title=&clean($title);
+ my $preamble = &authorspace_selector($r,$formname,$home,$title,%outhash);
+ my $display = '