raeburn Sun Dec 22 03:12:53 2024 EDT
Modified files:
/loncom/interface londocs.pm
Log:
- Copying files from Course Authoring Space to User's Authoring Space
In copies update metadata and links to dependencies.
-------------- next part --------------
Index: loncom/interface/londocs.pm
diff -u loncom/interface/londocs.pm:1.712 loncom/interface/londocs.pm:1.713
--- loncom/interface/londocs.pm:1.712 Fri Dec 20 15:15:04 2024
+++ loncom/interface/londocs.pm Sun Dec 22 03:12:53 2024
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Documents
#
-# $Id: londocs.pm,v 1.712 2024/12/20 15:15:04 raeburn Exp $
+# $Id: londocs.pm,v 1.713 2024/12/22 03:12:53 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -48,6 +48,7 @@
use Apache::loncourserespicker();
use HTML::Entities;
use HTML::TokeParser;
+use HTML::LCParser;
use GDBM_File;
use File::MMagic;
use File::Copy;
@@ -804,8 +805,7 @@
return '';
}
if (keys(%tocopy)) {
- my $mm = new File::MMagic;
- my ($notopdir,%newdir,%newfile);
+ my ($notopdir,%newdir,%newfile,%checkdeps);
$r->print('<p>'.&mt('Copy to: [_1]',
'<span class="LC_filename">'.$desturl.'/'.$subdir.'</span>').
'</p>'."\n");
@@ -896,13 +896,191 @@
$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
+ 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";
+ }
+ } 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') {
-#FIXME in any src or href attributes replace /res/$coursedom/$coursenum/ with /res/$cd/$ca/$subdir
+ 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 ++;
+ }
+ }
+ }
+ }
+ # 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;
+ }
+ }
+ 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;
+ }
+ }
+ 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);
+ } 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 =~ 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 ++;
+ }
+ $outstring .= $script;
+ }
+ }
+ } 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);
+ }
+ }
}
}
}
@@ -928,6 +1106,20 @@
'</p>'."\n".
'<ul><li>'.join('</li><li>',sort(keys(%newfile))).'</li></ul></p>'."\n");
}
+ if (keys(%checkdeps)) {
+ my %missingdep;
+ foreach my $depfile (sort(keys(%checkdeps))) {
+ unless (-e "$desttop/$depfile") {
+ $missingdep{$depfile} = 1;
+ }
+ }
+ if (keys(%missingdep)) {
+ $r->print('<p>'.&mt('You may also need to copy the following missing dependencies for files copied to [_1]:',
+ '<span class="LC_filename">'.$desturl.'/'.$subdir.'</span>').
+ '</p>'."\n".
+ '<ul><li>'.join('</li><li>',sort(keys(%missingdep))).'</li></ul></p>'."\n");
+ }
+ }
} else {
$r->print('<p>'.&mt('No currently existing files or directories in Course Authoring Space selected for copying').'</p>');
$r->print(&endContentScreen());