--- loncom/interface/londocs.pm 2024/12/22 03:12:53 1.713 +++ 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.713 2024/12/22 03:12:53 raeburn Exp $ +# $Id: londocs.pm,v 1.714 2024/12/27 02:32:55 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -723,6 +723,11 @@ ENDJS $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"; @@ -755,16 +760,11 @@ ENDJS &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); + &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; @@ -805,289 +805,301 @@ ENDJS 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"); - 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; - } + 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 ($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)) { - 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; + 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 { - $fail = 1; + $src = "$srctop/$path/$fname"; + $dest = "$desttop/$subdir/$path/$fname"; } - } elsif (-e "$desttop/$subdir/$file") { - $dup = 1; + } elsif (-f "$desttop/$subdir/$path") { + $dir_is_file = 1; } else { - $src = "$srctop/$file"; - $dest = "$desttop/$subdir/$file"; - $fname = $file; + $fail = 1; } - 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 '')) { + } 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')) { - if (open(my $fh,'<',$dest.'.meta')) { - my ($output,$now); - $now = time; - while (my $line=<$fh>) { - chomp($line); - if ($line eq "$coursenum:$coursedom") { - $output .= "$ca:$cd\n"; - } elsif ($line eq 'custom') { - $output .= "default\n"; - } elsif ($line =~ m{^\d+$}) { - $output .= "$now\n"; - } elsif ($line eq "/res/$coursedom/$coursenum/default.rights") { - $output .= "\n"; - } 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"; - } + $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 "$coursenum:$coursedom") { + $output .= "$ca:$cd\n"; + } elsif ($line eq 'custom') { + $output .= "default\n"; + } elsif ($line =~ m{^\d+$}) { + $output .= "$now\n"; + } elsif ($line eq "/res/$coursedom/$coursenum/default.rights") { + $output .= "\n"; + } 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 { - $output .= "$line\n"; + push(@newdeps,$dep); } } - close($fh); - if (open(my $fh,'>',$dest.'.meta')) { - print $fh $output; - close($fh); + if ($changed) { + $output .= ''.join(',',@newdeps).''."\n"; } + } else { + $output .= "$line\n"; } } + close($fh); + if (open(my $fh,'>',$dest.'.meta')) { + print $fh $output; + close($fh); + } } - my ($ext) = ($file =~ /\.(\w+)$/); - my $embstyle=&Apache::loncommon::fileembstyle($ext); - if ($embstyle eq 'ssi') { - my $outstring=''; - my $changes = 0; - my @parser; - $parser[0]=HTML::LCParser->new($src); - $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 ++; - } + } + my ($ext) = ($file =~ /\.(\w+)$/); + my $embstyle=&Apache::loncommon::fileembstyle($ext); + if ($embstyle eq 'ssi') { + 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