[BACK]Return to londocs.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/londocs.pm between versions 1.712 and 1.713

version 1.712, 2024/12/20 15:15:04 version 1.713, 2024/12/22 03:12:53
Line 48  use Apache::lonpublisher(); Line 48  use Apache::lonpublisher();
 use Apache::loncourserespicker();  use Apache::loncourserespicker();
 use HTML::Entities;  use HTML::Entities;
 use HTML::TokeParser;  use HTML::TokeParser;
   use HTML::LCParser;
 use GDBM_File;  use GDBM_File;
 use File::MMagic;  use File::MMagic;
 use File::Copy;  use File::Copy;
Line 804  ENDJS Line 805  ENDJS
             return '';              return '';
         }          }
         if (keys(%tocopy)) {          if (keys(%tocopy)) {
             my $mm = new File::MMagic;              my ($notopdir,%newdir,%newfile,%checkdeps);
             my ($notopdir,%newdir,%newfile);  
             $r->print('<p>'.&mt('Copy to: [_1]',              $r->print('<p>'.&mt('Copy to: [_1]',
                                 '<span class="LC_filename">'.$desturl.'/'.$subdir.'</span>').                                  '<span class="LC_filename">'.$desturl.'/'.$subdir.'</span>').
                       '</p>'."\n");                        '</p>'."\n");
Line 896  ENDJS Line 896  ENDJS
                                     $newfile{$file} = 1;                                      $newfile{$file} = 1;
                                     if ((-e $src.'.meta') && (!-e $dest.'.meta')) {                                      if ((-e $src.'.meta') && (!-e $dest.'.meta')) {
                                         if (&File::Copy::copy($src.'.meta',$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 ($ext) = ($file =~ /\.(\w+)$/);
                                     my $embstyle=&Apache::loncommon::fileembstyle($ext);                                      my $embstyle=&Apache::loncommon::fileembstyle($ext);
                                     if ($embstyle eq 'ssi') {                                      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);
                                               }
                                           }
                                     }                                      }
                                 }                                  }
                             }                              }
Line 928  ENDJS Line 1106  ENDJS
                           '</p>'."\n".                            '</p>'."\n".
                           '<ul><li>'.join('</li><li>',sort(keys(%newfile))).'</li></ul></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 {          } else {
             $r->print('<p>'.&mt('No currently existing files or directories in Course Authoring Space selected for copying').'</p>');              $r->print('<p>'.&mt('No currently existing files or directories in Course Authoring Space selected for copying').'</p>');
             $r->print(&endContentScreen());              $r->print(&endContentScreen());
Removed from v.1.712  
changed lines
  Added in v.1.713

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>