--- loncom/interface/londocs.pm 2010/07/05 12:29:36 1.429
+++ 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.429 2010/07/05 12:29:36 droeschl 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;
@@ -41,10 +39,21 @@ 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;
@@ -55,6 +64,7 @@ my $hashtied;
my %alreadyseen=();
my $hadchanges;
+my $suppchanges;
my %help=();
@@ -68,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);
}
@@ -84,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;
@@ -100,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++;
}
}
@@ -115,856 +138,980 @@ sub authorhosts {
}
-sub dumpbutton {
- my ($home,$other,%outhash)=&authorhosts();
- my $crstype = &Apache::loncommon::course_type();
- if ($home+$other==0) { return ''; }
- if ($home) {
- my $link =
- ""
- .&mt('Dump '.$crstype.' Documents to Construction Space')
- .'';
- return
- $link.' '
- .&Apache::loncommon::help_open_topic('Docs_Dump_Course_Docs')
- .' ';
- } else {
- return
- &mt('Dump '.$crstype.' Documents to Construction Space: available on other servers');
- }
-}
-
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 $folderpath;
+ }
+}
+sub validate_supppath {
+ my ($coursenum,$coursedom) = @_;
+ my $backto;
+ if ($env{'form.supppath'} ne '') {
+ my @items = split(/\&/,$env{'form.supppath'});
+ my ($badpath,$got_supp,$supppath,%supphidden,%suppids);
+ for (my $i=0; $i<@items; $i++) {
+ my $odd = $i%2;
+ if ((!$odd) && ($items[$i] !~ /^supplemental(|_\d+)$/)) {
+ $badpath = 1;
+ last;
+ } elsif ($odd) {
+ my $suffix;
+ my $idx = $i-1;
+ if ($items[$i] =~ /^([^:]*)::(|1):::$/) {
+ $backto .= '&'.$1;
+ } elsif ($items[$idx] eq 'supplemental') {
+ $backto .= '&'.$items[$i];
+ } else {
+ $backto .= '&'.$items[$i];
+ my $is_hidden;
+ unless ($got_supp) {
+ my ($supplemental) = &Apache::loncommon::get_supplemental($coursenum,$coursedom);
+ if (ref($supplemental) eq 'HASH') {
+ if (ref($supplemental->{'hidden'}) eq 'HASH') {
+ %supphidden = %{$supplemental->{'hidden'}};
+ }
+ if (ref($supplemental->{'ids'}) eq 'HASH') {
+ %suppids = %{$supplemental->{'ids'}};
+ }
+ }
+ $got_supp = 1;
+ }
+ if (ref($suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}) eq 'ARRAY') {
+ my $mapid = $suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}->[0];
+ if ($supphidden{$mapid}) {
+ $is_hidden = 1;
+ }
+ }
+ $suffix = '::'.$is_hidden.':::';
+ }
+ $supppath .= '&'.$items[$i].$suffix;
+ } else {
+ $supppath .= '&'.$items[$i];
+ $backto .= '&'.$items[$i];
+ }
+ }
+ if ($badpath) {
+ delete($env{'form.supppath'});
+ } else {
+ $supppath =~ s/^\&//;
+ $backto =~ s/^\&//;
+ $env{'form.supppath'} = $supppath;
+ }
+ }
+ return $backto;
+}
sub dumpcourse {
my ($r) = @_;
my $crstype = &Apache::loncommon::course_type();
- $r->print(&Apache::loncommon::start_page('Dump '.$crstype.' Documents to Construction Space').
- '
');
- }
-}
-
-
-
-sub exportbutton {
- my $crstype = &Apache::loncommon::course_type();
- return "".&mt('IMS Export')."".
- &Apache::loncommon::help_open_topic('Docs_Export_Course_Docs').' ';
-}
-
-
-
-sub exportcourse {
- my $r=shift;
- my $crstype = &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 '.$crstype.' to IMS Package').
- '
'.&mt('IMS Export Failed').'
'.
- '
');
- if ($crstype eq 'Community') {
- $r->print(&mt('Unable to retrieve information about community contents'));
- } else {
- $r->print(&mt('Unable to retrieve information about course contents'));
- }
- $r->print('
');
- if ($crstype eq 'Community') {
- $r->print(&mt('Return to Community Editor'));
- } else {
- $r->print(&mt('Return to Course Editor'));
- }
- $r->print('');
- &Apache::lonnet::logthis('IMS export failed - could not create navmap object in '.lc($crstype).':'.$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 =
- '
'
- .&mt('As you did not select any content items or discussions'
- .' for export, an IMS package has not been created.')
- .'
'
- .'
'
- .&mt('Please [_1]go back[_2] 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('[_1]Your IMS package[_2] is ready for download.'
- ,'','')
- .'
';
- 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 your course at this time,'
- .' because there was a problem creating a'
- .' manifest file.')
- .'
'.&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;
}
- } else {
- $$message = 'Could not render '.$url.' server message - '.$rtncode." \n";
}
- } 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 ($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 = '