--- loncom/interface/londocs.pm 2010/02/02 01:30:46 1.325.2.7 +++ 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.325.2.7 2010/02/02 01:30:46 raeburn 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,12 +64,12 @@ my $hashtied; my %alreadyseen=(); my $hadchanges; +my $suppchanges; my %help=(); - sub mapread { my ($coursenum,$coursedom,$map)=@_; return @@ -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,864 +138,986 @@ sub authorhosts { } -sub dumpbutton { - my ($home,$other,%outhash)=&authorhosts(); - my $crstype = &Apache::loncommon::course_type(); - if ($home+$other==0) { return ''; } - if ($home) { - return '
' - .&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 this posts at this time,' - .' because there was a problem creating a' - .' manifest file.') - .'
' - .''; - } - } - $r->print(&Apache::loncommon::start_page('Export '.$crstype.' to IMS Package')); - $r->print(&Apache::lonhtmlcommon::breadcrumbs('IMS Export')); - $r->print($outcome); - $r->print(&Apache::loncommon::end_page()); - } else { - my $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". -''.&mt('No author or co-author roles on this server.').'
'); + $r->print(&endContentScreen()); + return ''; + } + my %origcrsdata=&Apache::lonnet::coursedescription($env{'request.course.id'}); + my $exclude = &Apache::lonnet::priv_exclude(); + my $srcurl = "/priv/$coursedom/$coursenum"; + my $srctop = $r->dir_config('lonDocRoot').$srcurl; + if (($env{'form.authorspace'}) && ($env{'form.authorfolder'}=~/\w/)) { + $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 $desttop = $r->dir_config('lonDocRoot').$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 $is_course_home; + my @ids=&Apache::lonnet::current_machine_ids(); + if (($coursehome ne '') && (grep(/^\Q$coursehome\E$/,@ids))) { + $is_course_home = 1; + } + 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($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}); + } + } + } + } else { + $r->print(''.&mt('No files or directories selected for copying').'
'); + $r->print(&endContentScreen()); + return ''; + } + if (keys(%tocopy)) { + my $mm = new File::MMagic; + my ($notopdir,%newdir,%newfile); + $r->print(''.&mt('Copy to: [_1]', + ''.$desturl.'/'.$subdir.''). + '
'."\n"); + unless ($is_course_home) { + $r->print(''. + &endContentScreen()); + return ''; + } + if (keys(%dirs_to_make)) { + if ($is_course_home) { + 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; + } } - } 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'); + } + if (keys(%files_to_copy)) { + if ($is_course_home) { + unless (-e $desttop.'/'.$subdir) { + mkdir($desttop.'/'.$subdir,0755); + } + if (-e $desttop.'/'.$subdir) { + my $num = 0; + foreach my $file (keys(%files_to_copy)) { + my ($fail,$dup,$dir_is_file,$src,$dest,$path,$fname); + if ($file =~ m{/}) { + ($path,$fname) = ($file =~ m{^(.+)/([^/]+)$}); + if (-d "$desttop/$subdir/$path") { + if (-e "$desttop/$subdir/$path/$fname") { + $dup = 1; + } else { + $src = "$srctop/$path/$fname"; + $dest = "$desttop/$subdir/$path/$fname"; + } + } elsif (-f "$desttop/$subdir/$path") { + $dir_is_file = 1; + } else { + $fail = 1; + } + } elsif (-e "$desttop/$subdir/$file") { + $dup = 1; + } else { + $src = "$srctop/$file"; + $dest = "$desttop/$subdir/$file"; + $fname = $file; + } + if ($fail) { + $r->print(''.&mt('Target directory: [_1] does not exist, and could not be created.', + ''.$desturl.'/'.$subdir.'/'.$path.''). + '
'."\n"); + } elsif ($dup) { + $r->print(''.&mt('Target file: [_1] already exists -- not overwriting.', + ''.$desturl.'/'.$subdir.'/'.$file.''). + '
'."\n"); + } elsif ($dir_is_file) { + $r->print(''.&mt('Target directory: [_1] name is already in a use for a file -- not overwriting.', + ''.$desturl.'/'.$subdir.'/'.$file.''). + '
'."\n"); + } elsif (($src ne '') && ($dest ne '')) { + if (&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."'.&mt('No files or sub-directories copied').'
'."\n".
+ ''.&mt('Target directory: [_1] does not exist, and could not be created.',
+ ''.$desturl.'/'.$subdir.'').
+ '
'.&mt('Created the following directories in [_1]:',''.$desturl.'/'.$subdir.''). + '
'."\n". + ''.&mt('Copied the following files to [_1]:',''.$desturl.'/'.$subdir.''). + '
'."\n". + ''.&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."