--- loncom/interface/londocs.pm 2017/08/31 20:02:35 1.639 +++ loncom/interface/londocs.pm 2024/12/27 02:32:55 1.714 @@ -1,7 +1,7 @@ # The LearningOnline Network # Documents # -# $Id: londocs.pm,v 1.639 2017/08/31 20:02:35 raeburn Exp $ +# $Id: londocs.pm,v 1.714 2024/12/27 02:32:55 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -45,13 +45,16 @@ 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; @@ -88,7 +91,7 @@ sub storemap { if ($map =~ /^default/) { $hadchanges=1; - } else { + } elsif ($contentchg) { $suppchanges=1; } return ($errtext,0); @@ -100,6 +103,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; @@ -116,7 +120,6 @@ 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; @@ -180,6 +183,64 @@ sub default_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(); @@ -203,11 +264,12 @@ ENDJS add_entries => {'onload' => "hide_searching();"}, }; } - $r->print(&Apache::loncommon::start_page('Copy '.$crstype.' Content to Authoring Space',$js,$starthash)."\n". - &Apache::lonhtmlcommon::breadcrumbs('Copy '.$crstype.' Content to Authoring Space')."\n"); + $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 ''; } @@ -216,7 +278,8 @@ ENDJS if (($env{'form.authorspace'}) && ($env{'form.authorfolder'}=~/\w/)) { # Do the dumping unless ($outhash{'home_'.$env{'form.authorspace'}}) { - $r->print(&endContentScreen()); + $r->print(''.&mt('Selected Authoring Space is not on this server.').'
'. + &endContentScreen()); return ''; } my ($ca,$cd)=split(/\:/,$env{'form.authorspace'}); @@ -512,49 +575,12 @@ $contents{webreferences}.' if (!ref($navmap)) { $r->print($errormsg); } else { - $r->print(''.&mt('No author or co-author roles on this server.').'
'); + $r->print(&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 %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 (%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); + my $resurl = "/res/$coursedom/$coursenum"; + my $res_exclude = &Apache::lonnet::res_exclude(); + &Apache::lonnet::recursedirs($is_course_home,1,undef,$res_exclude,0,0,$resurl,'',\%resdirs,\%resfiles); + my ($notopdir,%newdir,%newfile,%checkdeps); + $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; + 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 ($is_course_home) { + if (&File::Copy::copy($src,$dest)) { + $newfile{$file} = 1; + } + } else { + if (&Apache::lonnet::repcopy_crsprivfile($srcurl.'/'.$file,$dest) eq 'ok') { + $newfile{$file} = 1; + } + } + if ($newfile{$file}) { + my $gotmeta; + if ($is_course_home) { + if ((-e $src.'.meta') && (!-e $dest.'.meta')) { + if (&File::Copy::copy($src.'.meta',$dest.'.meta')) { + $gotmeta = 1; + } + } + } else { + if (&Apache::lonnet::repcopy_crsprivfile($srcurl.'/'.$file.'.meta',$dest.'.meta') eq 'ok') { + $gotmeta = 1; + } + } + if ($gotmeta) { + if (open(my $fh,'<',$dest.'.meta')) { + my ($output,$now); + $now = time; + while (my $line=<$fh>) { + chomp($line); + if ($line eq "