--- loncom/interface/londocs.pm	2024/12/20 15:15:04	1.712
+++ loncom/interface/londocs.pm	2024/12/22 03:12:53	1.713
@@ -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::lonpublisher();
 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 @@ ENDJS
             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 @@ ENDJS
                                     $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(',',@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 @@ ENDJS
                           '</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());