--- 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