[LON-CAPA-cvs] cvs: loncom / lond /interface londocs.pm /lonnet/perl lonnet.pm
raeburn
raeburn at source.lon-capa.org
Thu Dec 26 21:32:56 EST 2024
raeburn Fri Dec 27 02:32:56 2024 EDT
Modified files:
/loncom/interface londocs.pm
/loncom/lonnet/perl lonnet.pm
/loncom lond
Log:
- Support copying of directories and/or files from Course Authoring Space
to a user's authoring space in the case where the course's homeserver is
not the current server.
- Display last modification date and if published when listing files in
Course Authoring Space.
-------------- next part --------------
Index: loncom/interface/londocs.pm
diff -u loncom/interface/londocs.pm:1.713 loncom/interface/londocs.pm:1.714
--- loncom/interface/londocs.pm:1.713 Sun Dec 22 03:12:53 2024
+++ loncom/interface/londocs.pm Fri Dec 27 02:32:55 2024
@@ -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 @@
$r->print(&endContentScreen());
return '';
}
+ my $is_course_home;
+ my @ids=&Apache::lonnet::current_machine_ids();
+ if (($coursehome ne '') && (grep(/^\Q$coursehome\E$/, at 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 @@
&endContentScreen());
return '';
}
- my $is_course_home;
- my @ids=&Apache::lonnet::current_machine_ids();
- if (($coursehome ne '') && (grep(/^\Q$coursehome\E$/, at 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 @@
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('<p>'.&mt('Copy to: [_1]',
'<span class="LC_filename">'.$desturl.'/'.$subdir.'</span>').
'</p>'."\n");
- unless ($is_course_home) {
- $r->print('<p class="LC_info>'.&mt("Session needs to be hosted on course's home server.").
- '</p>'.
- &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('<p class="LC_warning">'.&mt('Target directory: [_1] does not exist, and could not be created.',
- '<span class="LC_filename">'.$desturl.'/'.$subdir.'/'.$dir.'</span>').
- '</p>'."\n");
}
}
- } else {
- $notopdir = 1;
+ if ($fail) {
+ $r->print('<p class="LC_warning">'.&mt('Target directory: [_1] does not exist, and could not be created.',
+ '<span class="LC_filename">'.$desturl.'/'.$subdir.'/'.$dir.'</span>').
+ '</p>'."\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;
- }
- if ($fail) {
- $r->print('<p class="LC_warning">'.&mt('Target directory: [_1] does not exist, and could not be created.',
- '<span class="LC_filename">'.$desturl.'/'.$subdir.'/'.$path.'</span>').
- '</p>'."\n");
- } elsif ($dup) {
- $r->print('<p class="LC_warning">'.&mt('Target file: [_1] already exists -- not overwriting.',
- '<span class="LC_filename">'.$desturl.'/'.$subdir.'/'.$file.'</span>').
- '</p>'."\n");
- } elsif ($dir_is_file) {
- $r->print('<p class="LC_warning">'.&mt('Target directory: [_1] name is already in a use for a file -- not overwriting.',
- '<span class="LC_filename">'.$desturl.'/'.$subdir.'/'.$file.'</span>').
- '</p>'."\n");
- } elsif (($src ne '') && ($dest ne '')) {
+ $fail = 1;
+ }
+ } elsif (-e "$desttop/$subdir/$file") {
+ $dup = 1;
+ } else {
+ $src = "$srctop/$file";
+ $dest = "$desttop/$subdir/$file";
+ $fname = $file;
+ }
+ if ($fail) {
+ $r->print('<p class="LC_warning">'.&mt('Target directory: [_1] does not exist, and could not be created.',
+ '<span class="LC_filename">'.$desturl.'/'.$subdir.'/'.$path.'</span>').
+ '</p>'."\n");
+ } elsif ($dup) {
+ $r->print('<p class="LC_warning">'.&mt('Target file: [_1] already exists -- not overwriting.',
+ '<span class="LC_filename">'.$desturl.'/'.$subdir.'/'.$file.'</span>').
+ '</p>'."\n");
+ } elsif ($dir_is_file) {
+ $r->print('<p class="LC_warning">'.&mt('Target directory: [_1] name is already in a use for a file -- not overwriting.',
+ '<span class="LC_filename">'.$desturl.'/'.$subdir.'/'.$file.'</span>').
+ '</p>'."\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 "<authorspace>$coursenum:$coursedom</authorspace>") {
- $output .= "<authorspace>$ca:$cd</authorspace>\n";
- } elsif ($line eq '<copyright>custom</copyright>') {
- $output .= "<copyright>default</copyright>\n";
- } elsif ($line =~ m{^<creationdate>\d+</creationdate>$}) {
- $output .= "<creationdate>$now</creationdate>\n";
- } elsif ($line eq "<customdistributionfile>/res/$coursedom/$coursenum/default.rights</customdistributionfile>") {
- $output .= "<customdistributionfile></customdistributionfile>\n";
- } elsif ($line eq "<domain>$coursedom</domain>") {
- $output .= "<domain>$cd</domain>\n";
- } elsif ($line =~ m{^<lastrevisiondate>\d+</lastrevisiondate>$}) {
- $output .= "<lastrevisiondate>$now</lastrevisiondate>\n";
- } elsif ($line =~ m{^<modifyinguser>$match_username:$match_domain</modifyinguser>$}) {
- $output .= "<modifyinguser>$env{'user.name'}:$env{'user.domain'}</modifyinguser>\n";
- } elsif ($line eq "<owner>$coursenum:$coursedom</owner>") {
- $output .= "<owner>$ca:$cd</owner>\n";
- } elsif ($line =~ m{^<dependencies>(.+)</dependencies>$}) {
- 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 .= '<dependencies>'.join(',', at newdeps).'</dependencies>'."\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 "<authorspace>$coursenum:$coursedom</authorspace>") {
+ $output .= "<authorspace>$ca:$cd</authorspace>\n";
+ } elsif ($line eq '<copyright>custom</copyright>') {
+ $output .= "<copyright>default</copyright>\n";
+ } elsif ($line =~ m{^<creationdate>\d+</creationdate>$}) {
+ $output .= "<creationdate>$now</creationdate>\n";
+ } elsif ($line eq "<customdistributionfile>/res/$coursedom/$coursenum/default.rights</customdistributionfile>") {
+ $output .= "<customdistributionfile></customdistributionfile>\n";
+ } elsif ($line eq "<domain>$coursedom</domain>") {
+ $output .= "<domain>$cd</domain>\n";
+ } elsif ($line =~ m{^<lastrevisiondate>\d+</lastrevisiondate>$}) {
+ $output .= "<lastrevisiondate>$now</lastrevisiondate>\n";
+ } elsif ($line =~ m{^<modifyinguser>$match_username:$match_domain</modifyinguser>$}) {
+ $output .= "<modifyinguser>$env{'user.name'}:$env{'user.domain'}</modifyinguser>\n";
+ } elsif ($line eq "<owner>$coursenum:$coursedom</owner>") {
+ $output .= "<owner>$ca:$cd</owner>\n";
+ } elsif ($line =~ m{^<dependencies>(.+)</dependencies>$}) {
+ 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 .= '<dependencies>'.join(',', at newdeps).'</dependencies>'."\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 <randomlabel> image type <label>
- # or a <image> tag inside <imageresponse> or <drawimage>
- if (($lctag eq 'label' && defined($parms{'description'}))
- || ($lctag eq 'image') || ($lctag eq 'import')) {
- my $next_token=$parser[-1]->get_token();
- if ($next_token->[0] eq 'T') {
- $next_token->[1] =~ s/[\n\r\f]+//g;
- if ($next_token->[1] =~ m{^\Q/res/$coursedom/$coursenum/\E}si) {
- $next_token->[1] =~ s{^\Q/res/$coursedom/$coursenum/\E}{/res/$cd/$ca/$subdir/}si;
+ }
+ # probably a <randomlabel> image type <label>
+ # or a <image> tag inside <imageresponse> or <drawimage>
+ if (($lctag eq 'label' && defined($parms{'description'}))
+ || ($lctag eq 'image') || ($lctag eq 'import')) {
+ my $next_token=$parser[-1]->get_token();
+ if ($next_token->[0] eq 'T') {
+ $next_token->[1] =~ s/[\n\r\f]+//g;
+ if ($next_token->[1] =~ m{^\Q/res/$coursedom/$coursenum/\E}si) {
+ $next_token->[1] =~ s{^\Q/res/$coursedom/$coursenum/\E}{/res/$cd/$ca/$subdir/}si;
+ $changes ++;
+ }
+ }
+ $parser[-1]->unget_token($next_token);
+ }
+ if ($lctag eq 'applet') {
+ my $havecodebase=0;
+ foreach my $key (keys(%parms)) {
+ if (lc($key) eq 'codebase') {
+ if ($parms{$key} =~ m{^\Q/res/$coursedom/$coursenum/\E}si) {
+ $parms{$key} =~ s{^\Q/res/$coursedom/$coursenum/\E}{/res/$cd/$ca/$subdir/}si;
$changes ++;
}
+ $havecodebase = 1;
}
- $parser[-1]->unget_token($next_token);
}
- if ($lctag eq 'applet') {
- my $havecodebase=0;
+ unless ($havecodebase) {
foreach my $key (keys(%parms)) {
- if (lc($key) eq 'codebase') {
+ if ($key =~ /(archive|code|object)/i) {
if ($parms{$key} =~ m{^\Q/res/$coursedom/$coursenum/\E}si) {
- $parms{$key} =~ s{^\Q/res/$coursedom/$coursenum/\E}{/res/$cd/$ca/$subdir/}si;
+ $parms{$key} =~ s{^\Q/res/$coursedom/$coursenum/\E}{/res/$cd/$ca/$subdir/si};
$changes ++;
}
- $havecodebase = 1;
- }
- }
- unless ($havecodebase) {
- foreach my $key (keys(%parms)) {
- if ($key =~ /(archive|code|object)/i) {
- 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 $newparmstring='';
- my $endtag='';
- foreach my $parkey (keys(%parms)) {
- if ($parkey eq '/') {
- $endtag=' /';
- } else {
- my $quote=($parms{$parkey}=~/\"/?"'":'"');
- $newparmstring.=' '.$parkey.'='.$quote.$parms{$parkey}.$quote;
- }
+ }
+ my $newparmstring='';
+ my $endtag='';
+ foreach my $parkey (keys(%parms)) {
+ if ($parkey eq '/') {
+ $endtag=' /';
+ } else {
+ my $quote=($parms{$parkey}=~/\"/?"'":'"');
+ $newparmstring.=' '.$parkey.'='.$quote.$parms{$parkey}.$quote;
}
- if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }
- $outstring.='<'.$tag.$newparmstring.$endtag.'>';
- if ($lctag eq 'm' || $lctag eq 'answer' || $lctag eq 'display' ||
- $lctag eq 'tex') {
+ }
+ if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }
+ $outstring.='<'.$tag.$newparmstring.$endtag.'>';
+ if ($lctag eq 'm' || $lctag eq 'answer' || $lctag eq 'display' ||
+ $lctag eq 'tex') {
+ $outstring.=&Apache::lonxml::get_all_text_unbalanced('/'.$lctag,\@parser);
+ } elsif ($lctag eq 'script') {
+ if ($parms{'type'} eq 'loncapa/perl') {
$outstring.=&Apache::lonxml::get_all_text_unbalanced('/'.$lctag,\@parser);
- } elsif ($lctag eq 'script') {
- if ($parms{'type'} eq 'loncapa/perl') {
- $outstring.=&Apache::lonxml::get_all_text_unbalanced('/'.$lctag,\@parser);
- } else {
- my $needsupdate;
- my $script = &Apache::lonxml::get_all_text_unbalanced('/'.$lctag,\@parser);
- if ($script =~ m{\.addMediaSrc\((["'])((?!\1).+)\1\);}) {
- my $src = $2;
- if ($src =~ m{^\Q/res/$coursedom/$coursenum/\E}si) {
- $needsupdate = 1;
- }
+ } else {
+ my $needsupdate;
+ my $script = &Apache::lonxml::get_all_text_unbalanced('/'.$lctag,\@parser);
+ if ($script =~ m{\.addMediaSrc\((["'])((?!\1).+)\1\);}) {
+ my $src = $2;
+ if ($src =~ m{^\Q/res/$coursedom/$coursenum/\E}si) {
+ $needsupdate = 1;
}
- if ($script =~ /\(document,\s*(['"])script\1,\s*\[([^\]]+)\]\);/s) {
- my $scriptslist = $2;
- my $needsupdate = 1;
- my @srcs = split(/\s*,\s*/,$scriptslist);
- foreach my $src (@srcs) {
- if ($src =~ /(["'])(?:(?!\1).)+\.js\1/) {
- my $quote = $1;
- my ($url) = ($src =~ m/\Q$quote\E([^$quote]+)\Q$quote\E/);
- if ($url =~ m{^\Q/res/$coursedom/$coursenum/\E}si) {
- $needsupdate = 1;
- }
+ }
+ if ($script =~ /\(document,\s*(['"])script\1,\s*\[([^\]]+)\]\);/s) {
+ my $scriptslist = $2;
+ my $needsupdate = 1;
+ my @srcs = split(/\s*,\s*/,$scriptslist);
+ foreach my $src (@srcs) {
+ if ($src =~ /(["'])(?:(?!\1).)+\.js\1/) {
+ my $quote = $1;
+ my ($url) = ($src =~ m/\Q$quote\E([^$quote]+)\Q$quote\E/);
+ if ($url =~ m{^\Q/res/$coursedom/$coursenum/\E}si) {
+ $needsupdate = 1;
}
}
}
- if ($script =~ m{loadScript\(\s*(['"])((?:(?!\1).)+\.js)\1,\s*function}is) {
- my $src = $2;
- if ($src =~ m{^\Q/res/$coursedom/$coursenum/\E}si) {
- $needsupdate = 1;
- }
- }
- if ($needsupdate) {
- $script =~ s{^\Q/res/$coursedom/$coursenum/\E}{/res/$cd/$ca/$subdir/gsi};
- $changes ++;
+ }
+ if ($script =~ m{loadScript\(\s*(['"])((?:(?!\1).)+\.js)\1,\s*function}is) {
+ my $src = $2;
+ if ($src =~ m{^\Q/res/$coursedom/$coursenum/\E}si) {
+ $needsupdate = 1;
}
- $outstring .= $script;
}
- }
- } elsif ($token->[0] eq 'E') {
- if ($token->[2]) {
- unless ($token->[1] eq 'allow') {
- $outstring.='</'.$token->[1].'>';
+ if ($needsupdate) {
+ $script =~ s{^\Q/res/$coursedom/$coursenum/\E}{/res/$cd/$ca/$subdir/gsi};
+ $changes ++;
}
+ $outstring .= $script;
}
- } else {
- $outstring.=$token->[1];
}
+ } elsif ($token->[0] eq 'E') {
+ if ($token->[2]) {
+ unless ($token->[1] eq 'allow') {
+ $outstring.='</'.$token->[1].'>';
+ }
+ }
+ } else {
+ $outstring.=$token->[1];
}
- pop(@parser);
}
- if ($changes) {
- if (open(my $fh,'>',$dest)) {
- print $fh $outstring;
- close($fh);
- }
+ pop(@parser);
+ }
+ if ($changes) {
+ if (open(my $fh,'>',$dest)) {
+ print $fh $outstring;
+ close($fh);
}
}
}
}
}
- } else {
- $notopdir = 1;
}
+ } else {
+ $notopdir = 1;
}
}
if ($notopdir) {
@@ -1130,7 +1142,7 @@
my $chkname = 'copytouser';
my $context = 'crsauthored';
my (%subdirs,%files, at dirs_by_depth, at files_by_depth,%parent,%children,%hierarchy, at checked_maps);
- &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,1);
foreach my $key (keys(%subdirs)) {
next if (($key eq '/') || ($key eq ''));
my @items = split(/\//,$key);
@@ -1154,11 +1166,15 @@
}
if (ref($files{$path}) eq 'HASH') {
foreach my $file (keys(%{$files{$path}})) {
- $files_by_depth[$depth]{$path}{$file} = 1;
+ $files_by_depth[$depth]{$path}{$file} = $files{$path}{$file};
}
}
}
my ($info,$display,$onsubmit,$togglebuttons,$disabled);
+ my (%resdirs,%resfiles);
+ my $resurl = "/res/$coursedom/$coursenum";
+ my $resexclude = &Apache::lonnet::res_exclude();
+ &Apache::lonnet::recursedirs($is_course_home,1,undef,$resexclude,0,0,$resurl,'',\%resdirs,\%resfiles);
if ($readonly) {
$disabled = ' disabled="disabled"';
}
@@ -1188,11 +1204,13 @@
$display .= &Apache::loncommon::start_data_table()."\n".
&Apache::loncommon::start_data_table_header_row().
'<th>'.&mt('Copy?').'</th>'.
- '<th>'.&mt('Title').'</th>'.
+ '<th>'.&mt('Name').'</th>'.
+ '<th>'.&mt('Last modified').'</th>'.
+ '<th>'.&mt('Published?').'</th>'.
&Apache::loncommon::end_data_table_header_row()."\n";
$count = &recurse_crsauthored(0,\@dirs_by_depth,\@files_by_depth,'/',$startcount,
$count,\$display,\%parent,\%children,$readonly,
- $formname,$chkname,\$lastcontainer);
+ $formname,$chkname,\$lastcontainer,\%resfiles);
$display .= &Apache::loncommon::end_data_table().'</fieldset>';
unless ($readonly) {
$display .= '</div><div style="padding:0;clear:both;margin:0;border:0"></div>'.
@@ -1209,8 +1227,9 @@
sub recurse_crsauthored {
my ($currdepth,$dirs_by_depth,$files_by_depth,$currpath,$startcount,$count,$displayref,
- $parent,$children,$readonly,$formname,$chkname,$lastcontainerref) = @_;
- return $count unless ((ref($dirs_by_depth) eq 'ARRAY') && (ref($files_by_depth) eq 'ARRAY'));
+ $parent,$children,$readonly,$formname,$chkname,$lastcontainerref,$resfilesref) = @_;
+ return $count unless ((ref($dirs_by_depth) eq 'ARRAY') && (ref($files_by_depth) eq 'ARRAY') &&
+ (ref($resfilesref) eq 'HASH'));
my ($disabled,$hasdirs,$hasfiles,%unique,%dirs,%files);
if ((ref($dirs_by_depth->[$currdepth]) eq 'HASH') &&
(ref($dirs_by_depth->[$currdepth]{$currpath}) eq 'HASH')) {
@@ -1256,11 +1275,11 @@
for (my $i=0; $i<$currdepth; $i++) {
$$displayref .= "$whitespace\n";
}
- $$displayref .= '<img '.$icon.' /> '.$item.'</td>'.
+ $$displayref .= '<img '.$icon.' /> '.$item.'</td><td> </td><td> </td>'.
&Apache::loncommon::end_data_table_row()."\n";
$count = &recurse_crsauthored($deeper,$dirs_by_depth,$files_by_depth,$newpath,
$startcount,$count,$displayref,$parent,$children,
- $readonly,$formname,$chkname,$lastcontainerref);
+ $readonly,$formname,$chkname,$lastcontainerref,$resfilesref);
}
if ($hasfiles && exists($files{$item})) {
$count ++;
@@ -1284,6 +1303,12 @@
} else {
$showpath = "/$currpath/";
}
+ my ($published,$lastmod);
+ if ((ref($resfilesref->{$currpath})) && (exists($resfilesref->{$currpath}{$item}))) {
+ $published = '<img src="'.$location.'/navmap.correct.gif" alt="'.&mt('yes').'" />';
+ } else {
+ $published = '<img src="'.$location.'/navmap.wrong.gif" alt="'.&mt('no').'" />';
+ }
$$displayref .= &Apache::loncommon::start_data_table_row().
'<td><input type="checkbox" name="'.$chkname.'" value="'.&escape($showpath.$item).'" '.
'onclick="javascript:checkResource(document.'.$formname.','."'$currelem'".')" '.
@@ -1292,6 +1317,8 @@
$$displayref .= "$whitespace\n";
}
$$displayref .= '<img '.$icon.$alttext.' /> '.$item.'</td>'.
+ '<td>'.&Apache::lonlocal::locallocaltime($files{$item}).'</td>'.
+ '<td style="text-align: center;">'.$published.'</td>'.
&Apache::loncommon::end_data_table_row()."\n";
}
}
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1531 loncom/lonnet/perl/lonnet.pm:1.1532
--- loncom/lonnet/perl/lonnet.pm:1.1531 Wed Dec 25 06:07:01 2024
+++ loncom/lonnet/perl/lonnet.pm Fri Dec 27 02:32:55 2024
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1531 2024/12/25 06:07:01 raeburn Exp $
+# $Id: lonnet.pm,v 1.1532 2024/12/27 02:32:55 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -12557,6 +12557,8 @@
# $relpath - Current path (relative to top level).
# $dirhashref - reference to hash to populate with URLs of directories (Required)
# $filehashref - reference to hash to populate with URLs of files (Optional)
+# $getlastmod - if true, will set value for each key in innerhash in $filehashref
+# to last modification time of file; value set to 1 otherwise.
#
# Returns: nothing
#
@@ -12569,7 +12571,8 @@
#
sub recursedirs {
- my ($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,$relpath,$dirhashref,$filehashref) = @_;
+ my ($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,
+ $relpath,$dirhashref,$filehashref,$getlastmod) = @_;
return unless (ref($dirhashref) eq 'HASH');
my $docroot = $perlvar{'lonDocRoot'};
my $currpath = $docroot.$toppath;
@@ -12577,7 +12580,7 @@
$currpath .= "/$relpath";
}
my ($savefile,$checkinc,$checkexc);
- if (ref($filehashref)) {
+ if (ref($filehashref) eq 'HASH') {
$savefile = 1;
}
if (ref($include) eq 'HASH') {
@@ -12600,7 +12603,8 @@
}
$dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1;
if ($recurse) {
- &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,$newpath,$dirhashref,$filehashref);
+ &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,
+ $toppath,$newpath,$dirhashref,$filehashref,$getlastmod);
}
} elsif (($savefile) || ($relpath eq '')) {
next if ($nonemptydir && $filecount);
@@ -12617,10 +12621,16 @@
$dirhashref->{'/'} = 1;
}
if ($savefile) {
+ my $value;
+ if ($getlastmod) {
+ ($value) = (stat("$currpath/$item"))[9];
+ } else {
+ $value = 1;
+ }
if ($relpath eq '') {
- $filehashref->{'/'}{$item} = 1;
+ $filehashref->{'/'}{$item} = $value
} else {
- $filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1;
+ $filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = $value;
}
}
$filecount ++;
@@ -12629,8 +12639,11 @@
closedir($dirh);
}
} else {
- my ($dirlistref,$listerror) =
- &dirlist($toppath.$relpath);
+ my $url = $toppath;
+ if ($relpath ne '') {
+ $url = $toppath.'/'.$relpath;
+ }
+ my ($dirlistref,$listerror) = &dirlist($url);
my @dir_lines;
my $dirptr=16384;
if (ref($dirlistref) eq 'ARRAY') {
@@ -12654,12 +12667,13 @@
}
$dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1;
if ($recurse) {
- &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,$newpath,$dirhashref,$filehashref);
+ &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,
+ $toppath,$newpath,$dirhashref,$filehashref,$getlastmod);
}
} elsif (($savefile) || ($relpath eq '')) {
next if ($nonemptydir && $filecount);
if ($checkinc || $checkexc) {
- my $extension;
+ my ($extension) = ($item =~ /\.(\w+)$/);
if ($checkinc) {
next unless ($extension && $include->{$extension});
}
@@ -12671,10 +12685,16 @@
$dirhashref->{'/'} = 1;
}
if ($savefile) {
+ my $value;
+ if ($getlastmod) {
+ $value = $mtime;
+ } else {
+ $value = 1;
+ }
if ($relpath eq '') {
- $filehashref->{'/'}{$item} = 1;
+ $filehashref->{'/'}{$item} = $value;
} else {
- $filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1;
+ $filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = $value;
}
}
$filecount ++;
@@ -12701,6 +12721,14 @@
};
}
+sub res_exclude {
+ return {
+ meta => 1,
+ subscription => 1,
+ rights => 1,
+ };
+}
+
# -------------------------------------------------------- Value of a Condition
# gets the value of a specific preevaluated condition
@@ -15170,6 +15198,49 @@
return 'ok';
}
+sub repcopy_crsprivfile {
+ my ($src,$dest) = @_;
+ my $result;
+ if ($src =~ m{^/priv/($match_domain)/($match_courseid)/(.+)$}) {
+ my ($cdom,$cnum,$filepath) = ($1,$2,$3);
+ $filepath =~ s/\.{2,}//g;
+ my $chome = &homeserver($cnum,$cdom);
+ unless ($chome eq 'no_host') {
+ my @ids=¤t_machine_ids();
+ unless (grep(/^\Q$chome\E$/, at ids)) {
+ if (&is_course($cdom,$cnum)) {
+ my $londocroot = $perlvar{'lonDocRoot'};
+ if ($dest =~ m{^\Q$londocroot/priv/\E$match_domain/$match_username/.*\Q$filepath\E$}) {
+ my $cmd = 'crsfilefrompriv:'.&escape($filepath).':'.&escape($cnum).':'.&escape($cdom);
+ $result = &reply($cmd,$chome);
+ unless (($result eq 'unknown_cmd') || ($result =~ /^error:/)) {
+ my $url = &unescape($result);
+ if ($url =~ m{^https?://[^/]+\Q/userfiles/$cdom/$cnum/priv/$filepath\E$}) {
+ my $request=new HTTP::Request('GET',$url);
+ my $response=&LONCAPA::LWPReq::makerequest($chome,$request,'',\%perlvar,1200,1);
+ if ($response->is_error()) {
+ $result = 'error: '.$response->status_line;
+ } else {
+ if (open(my $fh,'>',$dest)) {
+ print $fh $response->content;
+ close($fh);
+ $result = 'ok';
+ } else {
+ $result = 'error: nowrite';
+ }
+ }
+ } else {
+ $result = 'error: invalidurl';
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return $result;
+}
+
sub tokenwrapper {
my $uri=shift;
$uri=~s|^https?\://([^/]+)||;
Index: loncom/lond
diff -u loncom/lond:1.582 loncom/lond:1.583
--- loncom/lond:1.582 Fri Dec 27 01:04:00 2024
+++ loncom/lond Fri Dec 27 02:32:56 2024
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.582 2024/12/27 01:04:00 raeburn Exp $
+# $Id: lond,v 1.583 2024/12/27 02:32:56 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -65,7 +65,7 @@
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.582 $'; #' stupid emacs
+my $VERSION='$Revision: 1.583 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -223,6 +223,7 @@
courseidputhash => {remote => 1, domroles => 1, enroll => 1},
courselastaccess => {remote => 1, domroles => 1, enroll => 1},
coursesessions => {institutiononly => 1},
+ crsfilefrompriv => {remote => 1, enroll => 1},
currentauth => {remote => 1, domroles => 1, enroll => 1},
currentdump => {remote => 1, enroll => 1},
currentversion => {remote=> 1, content => 1},
@@ -1923,19 +1924,26 @@
my $ulsout='';
my $ulsfn;
- my ($crscheck,$toplevel,$currdom,$currnum,$skip);
+ my ($crscheck,$toplevel,$currdom,$currnum,$skip,$privdir_for_course);
unless ($islocal) {
my ($major,$minor) = split(/\./,$clientversion);
if (($major < 2) || ($major == 2 && $minor < 12)) {
$crscheck = 1;
}
+ if ($ulsdir =~ m{^/home/httpd/html/priv/($LONCAPA::match_domain)/($LONCAPA::match_courseid)}) {
+ my ($currdom,$currnum) = ($1,$2);
+ if (&LONCAPA::Lond::is_course($currdom,$currnum)) {
+ $privdir_for_course = 1;
+ }
+ }
}
if (-e $ulsdir) {
if(-d $ulsdir) {
unless (($getpropath) || ($getuserdir) ||
($ulsdir =~ m{^/home/httpd/html/(res/$LONCAPA::match_domain|userfiles/)}) ||
($ulsdir =~ m{^/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_name/userfiles}) ||
- (($ulsdir =~ m{^/home/httpd/html/priv/$LONCAPA::match_domain}) && ($islocal))) {
+ (($ulsdir =~ m{^/home/httpd/html/priv/$LONCAPA::match_domain}) && ($islocal)) ||
+ ($privdir_for_course)) {
&Failure($client,"refused\n",$userinput);
return 1;
}
@@ -2817,6 +2825,92 @@
}
#
+# Copy a file from /home/httpd/html/priv/domain/coursenum/
+# to /home/httpd/html/userfiles/domain/coursenum/priv
+#
+# Parameters:
+# $cmd - The command that got us here.
+# $tail - Tail of the command
+# : separated list of escaped values for
+# (a) relative path to a file in /priv/domain/coursenum
+# (b) coursenum
+# (c) domain
+# $client - File descriptor connected to client.
+# Returns
+# 0 - Requested to exit, caller should shut down.
+# 1 - Continue processing.
+#
+
+sub crs_filefrompriv_handler {
+ my ($cmd, $tail, $client) = @_;
+ my $userinput = "$cmd:$tail";
+ my ($path,$cnum,$cdom) = map { &unescape($_); } split(/:/,$tail);
+ $path =~ s/\.{2,}//g;
+ if (($path eq '') || ($path eq '.')) {
+ &Failure($client, "not_found\n", "$cmd:$tail");
+ } else {
+ $cdom = &LONCAPA::clean_domain($cdom);
+ $cnum = &LONCAPA::clean_courseid($cnum);
+ if (&LONCAPA::Lond::is_course($cdom,$cnum)) {
+ my $toplevel = "/userfiles/$cdom/$cnum/priv";
+ my $toppath = $perlvar{'lonDocRoot'}.$toplevel;
+ my $dest = $toppath.'/'.$path;
+ my $desturl = $toplevel.'/'.$path;
+ my $src = $perlvar{'lonDocRoot'}.'/priv/'.$cdom.'/'.$cnum.'/'.$path;
+ my ($dest_mtime, $src_mtime);
+ if (-e $dest) {
+ ($dest_mtime) = (stat($dest))[9];
+ }
+ if (-e $src) {
+ my $protocol = $Apache::lonnet::protocol{$perlvar{'lonHostID'}};
+ $protocol = 'http' if ($protocol ne 'https');
+ my $url = $protocol.'://'.&Apache::lonnet::hostname($perlvar{'lonHostID'}).$desturl;
+ ($src_mtime) = (stat($src))[9];
+ if ((-e $dest) && ($dest_mtime >= $src_mtime)) {
+ my $result = &escape($url);
+ &Reply($client,\$result,$userinput);
+ } else {
+ my $reldir = $toplevel;
+ my ($subdir,$fname) = ($path =~ m{^(.+)/([^/]+)$});
+ if ($subdir eq '') {
+ $fname = $path;
+ } else {
+ $reldir .= '/'.$subdir;
+ }
+ my $targetdir = $perlvar{'lonDocRoot'};
+ my $dirfail;
+ foreach my $part (split(/\//,$reldir)) {
+ $targetdir .= '/'.$part;
+ if ((-e $targetdir)!=1) {
+ unless (mkdir($targetdir,0755)) {
+ $dirfail = 1;
+ last;
+ }
+ }
+ }
+ if ($dirfail) {
+ &Failure($client,"error: mkdir_failed\n", $userinput);
+ } else {
+ if (File::Copy::copy($src,$dest)) {
+ my $result = &escape($url);
+ &Reply($client,\$result,$userinput);
+ } else {
+ &Failure($client,"error: copy_failed\n", $userinput);
+ }
+ }
+ }
+ } else {
+ &Failure($client,"error: not_found\n", $userinput);
+ }
+ } else {
+ &Failure($client, "error: not_course\n", $userinput);
+ }
+ }
+ return 1;
+}
+®ister_handler("crsfilefrompriv", \&crs_filefrompriv_handler, 0, 1, 0);
+
+#
# Fetch a user file from a remote server to the user's home directory
# userfiles subdir.
# Parameters:
More information about the LON-CAPA-cvs
mailing list