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

version 1.713, 2024/12/22 03:12:53 version 1.714, 2024/12/27 02:32:55
Line 723  ENDJS Line 723  ENDJS
         $r->print(&endContentScreen());          $r->print(&endContentScreen());
         return '';          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 %origcrsdata=&Apache::lonnet::coursedescription($env{'request.course.id'});
     my $exclude = &Apache::lonnet::priv_exclude();      my $exclude = &Apache::lonnet::priv_exclude();
     my $srcurl = "/priv/$coursedom/$coursenum";      my $srcurl = "/priv/$coursedom/$coursenum";
Line 755  ENDJS Line 760  ENDJS
                       &endContentScreen());                        &endContentScreen());
             return '';              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);          my (%tocopy,%dirs_to_make,%files_to_copy);
         map { $tocopy{&unescape($_)} = 1; } &Apache::loncommon::get_env_multiple('form.copytouser');          map { $tocopy{&unescape($_)} = 1; } &Apache::loncommon::get_env_multiple('form.copytouser');
         if (keys(%tocopy)) {          if (keys(%tocopy)) {
             my (%subdirs,%files);              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))) {              foreach my $possible (sort(keys(%tocopy))) {
                 if ($possible =~ m{/$}) {                  if ($possible =~ m{/$}) {
                     my $possdir = $possible;                      my $possdir = $possible;
Line 805  ENDJS Line 805  ENDJS
             return '';              return '';
         }          }
         if (keys(%tocopy)) {          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);              my ($notopdir,%newdir,%newfile,%checkdeps);
             $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");
             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 (keys(%dirs_to_make)) {
                 if ($is_course_home) {                  unless (-e $desttop.'/'.$subdir) {
                     unless (-e $desttop.'/'.$subdir) {                      mkdir($desttop.'/'.$subdir,0755);
                         mkdir($desttop.'/'.$subdir,0755);                  }
                     }                  if (-e $desttop.'/'.$subdir) {
                     if (-e $desttop.'/'.$subdir) {                      foreach my $dir (sort(keys(%dirs_to_make))) {
                         foreach my $dir (sort(keys(%dirs_to_make))) {                          my @dirs=split(/\//,$dir);
                             my @dirs=split(/\//,$dir);                          my $path="$desttop/$subdir";
                             my $path="$desttop/$subdir";                          my $makepath=$path;
                             my $makepath=$path;                          my $fail;
                             my $fail;                          for (my $i=0;$i<@dirs;$i++) {
                             for (my $i=0;$i<@dirs;$i++) {                              $makepath.='/'.$dirs[$i];
                                 $makepath.='/'.$dirs[$i];                              unless (-e $makepath) {
                                 unless (-e $makepath) {                                  unless (mkdir($makepath,0755)) {
                                     unless (mkdir($makepath,0755)) {                                      $fail = 1;
                                         $fail = 1;                                      last;
                                         last;                                  }
                                     }                                  if (($i == scalar(@dirs)-1) && (!$fail))  {
                                     if (($i == scalar(@dirs)-1) && (!$fail))  {                                      $newdir{$dir} = 1;
                                         $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 {                          if ($fail) {
                         $notopdir = 1;                              $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 (keys(%files_to_copy)) {
                 if ($is_course_home) {                  unless (-e $desttop.'/'.$subdir) {
                     unless (-e $desttop.'/'.$subdir) {                      mkdir($desttop.'/'.$subdir,0755);
                         mkdir($desttop.'/'.$subdir,0755);                  }
                     }                  if (-e $desttop.'/'.$subdir) {
                     if (-e $desttop.'/'.$subdir) {                      my $num = 0;
                         my $num = 0;                      foreach my $file (keys(%files_to_copy)) {
                         foreach my $file (keys(%files_to_copy)) {                          my ($fail,$dup,$dir_is_file,$src,$dest,$path,$fname);
                             my ($fail,$dup,$dir_is_file,$src,$dest,$path,$fname);                          if ($file =~ m{/}) {
                             if ($file =~ m{/}) {                              ($path,$fname) = ($file =~ m{^(.+)/([^/]+)$});
                                 ($path,$fname) = ($file =~ m{^(.+)/([^/]+)$});                              if (-d "$desttop/$subdir/$path") {
                                 if (-d "$desttop/$subdir/$path") {                                  if (-e "$desttop/$subdir/$path/$fname") {
                                     if (-e "$desttop/$subdir/$path/$fname") {                                      $dup = 1;
                                         $dup = 1;  
                                     } else {  
                                         $src = "$srctop/$path/$fname";  
                                         $dest = "$desttop/$subdir/$path/$fname";  
                                     }  
                                 } elsif (-f "$desttop/$subdir/$path") {  
                                     $dir_is_file = 1;  
                                 } else {                                  } else {
                                     $fail = 1;                                      $src = "$srctop/$path/$fname";
                                       $dest = "$desttop/$subdir/$path/$fname";
                                 }                                  }
                             } elsif (-e "$desttop/$subdir/$file") {                              } elsif (-f "$desttop/$subdir/$path") {
                                 $dup = 1;                                  $dir_is_file = 1;
                             } else {                              } else {
                                 $src = "$srctop/$file";                                  $fail = 1;
                                 $dest = "$desttop/$subdir/$file";  
                                 $fname = $file;  
                             }                              }
                             if ($fail) {                          } elsif (-e "$desttop/$subdir/$file") {
                                 $r->print('<p class="LC_warning">'.&mt('Target directory: [_1] does not exist, and could not be created.',                              $dup = 1;
                                                                        '<span class="LC_filename">'.$desturl.'/'.$subdir.'/'.$path.'</span>').                          } else {
                                           '</p>'."\n");                              $src = "$srctop/$file";
                             } elsif ($dup) {                              $dest = "$desttop/$subdir/$file";
                                 $r->print('<p class="LC_warning">'.&mt('Target file: [_1] already exists -- not overwriting.',                              $fname = $file;
                                                                        '<span class="LC_filename">'.$desturl.'/'.$subdir.'/'.$file.'</span>').                          }
                                           '</p>'."\n");                          if ($fail) {
                             } elsif ($dir_is_file) {                              $r->print('<p class="LC_warning">'.&mt('Target directory: [_1] does not exist, and could not be created.',
                                 $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.'/'.$path.'</span>').
                                                                        '<span class="LC_filename">'.$desturl.'/'.$subdir.'/'.$file.'</span>').                                        '</p>'."\n");
                                           '</p>'."\n");                          } elsif ($dup) {
                             } elsif (($src ne '') && ($dest ne '')) {                              $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)) {                                  if (&File::Copy::copy($src,$dest)) {
                                     $newfile{$file} = 1;                                      $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 ((-e $src.'.meta') && (!-e $dest.'.meta')) {
                                         if (&File::Copy::copy($src.'.meta',$dest.'.meta')) {                                          if (&File::Copy::copy($src.'.meta',$dest.'.meta')) {
                                             if (open(my $fh,'<',$dest.'.meta')) {                                              $gotmeta = 1;
                                                 my ($output,$now);                                          }
                                                 $now = time;                                      }
                                                 while (my $line=<$fh>) {                                  } else {
                                                     chomp($line);                                      if (&Apache::lonnet::repcopy_crsprivfile($srcurl.'/'.$file.'.meta',$dest.'.meta') eq 'ok') {
                                                     if ($line eq "<authorspace>$coursenum:$coursedom</authorspace>") {                                          $gotmeta = 1;
                                                         $output .= "<authorspace>$ca:$cd</authorspace>\n";                                      }
                                                     } elsif ($line eq '<copyright>custom</copyright>') {                                  }
                                                         $output .= "<copyright>default</copyright>\n";                                  if ($gotmeta) {
                                                     } elsif ($line =~ m{^<creationdate>\d+</creationdate>$}) {                                      if (open(my $fh,'<',$dest.'.meta')) {
                                                         $output .= "<creationdate>$now</creationdate>\n";                                          my ($output,$now);
                                                     } elsif ($line eq "<customdistributionfile>/res/$coursedom/$coursenum/default.rights</customdistributionfile>") {                                          $now = time;
                                                         $output .= "<customdistributionfile></customdistributionfile>\n";                                          while (my $line=<$fh>) {
                                                     } elsif ($line eq "<domain>$coursedom</domain>") {                                              chomp($line);
                                                         $output .= "<domain>$cd</domain>\n";                                              if ($line eq "<authorspace>$coursenum:$coursedom</authorspace>") {
                                                     } elsif ($line =~ m{^<lastrevisiondate>\d+</lastrevisiondate>$}) {                                                  $output .= "<authorspace>$ca:$cd</authorspace>\n";
                                                         $output .= "<lastrevisiondate>$now</lastrevisiondate>\n";                                              } elsif ($line eq '<copyright>custom</copyright>') {
                                                     } elsif ($line =~ m{^<modifyinguser>$match_username:$match_domain</modifyinguser>$}) {                                                  $output .= "<copyright>default</copyright>\n";
                                                         $output .= "<modifyinguser>$env{'user.name'}:$env{'user.domain'}</modifyinguser>\n";                                              } elsif ($line =~ m{^<creationdate>\d+</creationdate>$}) {
                                                     } elsif ($line eq "<owner>$coursenum:$coursedom</owner>") {                                                  $output .= "<creationdate>$now</creationdate>\n";
                                                         $output .= "<owner>$ca:$cd</owner>\n";                                              } elsif ($line eq "<customdistributionfile>/res/$coursedom/$coursenum/default.rights</customdistributionfile>") {
                                                     } elsif ($line =~ m{^<dependencies>(.+)</dependencies>$}) {                                                  $output .= "<customdistributionfile></customdistributionfile>\n";
                                                         my @deps = split(/\s*,\s*/,$1);                                              } elsif ($line eq "<domain>$coursedom</domain>") {
                                                         my @newdeps;                                                  $output .= "<domain>$cd</domain>\n";
                                                         my $changed = 0;                                              } elsif ($line =~ m{^<lastrevisiondate>\d+</lastrevisiondate>$}) {
                                                         foreach my $dep (@deps) {                                                  $output .= "<lastrevisiondate>$now</lastrevisiondate>\n";
                                                             if ($dep =~ m{^/res/$coursedom/$coursenum/(.+)$}) {                                              } elsif ($line =~ m{^<modifyinguser>$match_username:$match_domain</modifyinguser>$}) {
                                                                 my $rest = $1;                                                  $output .= "<modifyinguser>$env{'user.name'}:$env{'user.domain'}</modifyinguser>\n";
                                                                 push(@newdeps,"/res/$cd/$ca/$rest");                                              } elsif ($line eq "<owner>$coursenum:$coursedom</owner>") {
                                                                 $checkdeps{$rest} = 1;                                                  $output .= "<owner>$ca:$cd</owner>\n";
                                                                 $changed ++;                                              } elsif ($line =~ m{^<dependencies>(.+)</dependencies>$}) {
                                                             } else {                                                  my @deps = split(/\s*,\s*/,$1);
                                                                 push(@newdeps,$dep);                                                  my @newdeps;
                                                             }                                                  my $changed = 0;
                                                         }                                                  foreach my $dep (@deps) {
                                                         if ($changed) {                                                      if ($dep =~ m{^/res/$coursedom/$coursenum/(.+)$}) {
                                                             $output .= '<dependencies>'.join(',',@newdeps).'</dependencies>'."\n";                                                          my $rest = $1;
                                                         }                                                          push(@newdeps,"/res/$cd/$ca/$rest");
                                                           $checkdeps{$rest} = 1;
                                                           $changed ++;
                                                     } else {                                                      } else {
                                                         $output .= "$line\n";                                                          push(@newdeps,$dep);
                                                     }                                                      }
                                                 }                                                  }
                                                 close($fh);                                                  if ($changed) {
                                                 if (open(my $fh,'>',$dest.'.meta')) {                                                      $output .= '<dependencies>'.join(',',@newdeps).'</dependencies>'."\n";
                                                     print $fh $output;  
                                                     close($fh);  
                                                 }                                                  }
                                               } 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);                                  my ($ext) = ($file =~ /\.(\w+)$/);
                                     if ($embstyle eq 'ssi') {                                  my $embstyle=&Apache::loncommon::fileembstyle($ext);
                                         my $outstring='';                                  if ($embstyle eq 'ssi') {
                                         my $changes = 0;                                      my $outstring='';
                                         my @parser;                                      my $changes = 0;
                                         $parser[0]=HTML::LCParser->new($src);                                      my @parser;
                                         $parser[-1]->xml_mode(1);                                      $parser[0]=HTML::LCParser->new($dest);
                                         my $token;                                      $parser[-1]->xml_mode(1);
                                         while (@parser) {                                      my $token;
                                             while ($token=$parser[-1]->get_token) {                                      while (@parser) {
                                                 if ($token->[0] eq 'S') {                                          while ($token=$parser[-1]->get_token) {
                                                     my $tag=$token->[1];                                              if ($token->[0] eq 'S') {
                                                     my $lctag=lc($tag);                                                  my $tag=$token->[1];
                                                     my %parms=%{$token->[2]};                                                  my $lctag=lc($tag);
                                                     foreach my $type ('src','href','background','bgimg') {                                                  my %parms=%{$token->[2]};
                                                         foreach my $key (keys(%parms)) {                                                  foreach my $type ('src','href','background','bgimg') {
                                                             if ($key =~ /^$type$/i) {                                                      foreach my $key (keys(%parms)) {
                                                                 next if (($lctag eq 'img') && ($type eq 'src') &&                                                          if ($key =~ /^$type$/i) {
                                                                          ($parms{$key} =~ m{^data\:image/gif;base64,}));                                                              next if (($lctag eq 'img') && ($type eq 'src') &&
                                                                 if ($parms{$key} =~ m{^\Q/res/$coursedom/$coursenum/\E}si) {                                                                       ($parms{$key} =~ m{^data\:image/gif;base64,}));
                                                                     $parms{$key} =~ s{^\Q/res/$coursedom/$coursenum/\E}{/res/$cd/$ca/$subdir/}si;                                                              if ($parms{$key} =~ m{^\Q/res/$coursedom/$coursenum/\E}si) {
                                                                     $changes ++;                                                                  $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>                                                  # probably a <randomlabel> image type <label>
                                                     if (($lctag eq 'label' && defined($parms{'description'}))                                                  # or a <image> tag inside <imageresponse> or <drawimage>
                                                          || ($lctag eq 'image') || ($lctag eq 'import')) {                                                  if (($lctag eq 'label' && defined($parms{'description'}))
                                                         my $next_token=$parser[-1]->get_token();                                                       || ($lctag eq 'image') || ($lctag eq 'import')) {
                                                         if ($next_token->[0] eq 'T') {                                                      my $next_token=$parser[-1]->get_token();
                                                             $next_token->[1] =~ s/[\n\r\f]+//g;                                                      if ($next_token->[0] eq 'T') {
                                                             if ($next_token->[1] =~ m{^\Q/res/$coursedom/$coursenum/\E}si) {                                                          $next_token->[1] =~ s/[\n\r\f]+//g;
                                                                 $next_token->[1] =~ s{^\Q/res/$coursedom/$coursenum/\E}{/res/$cd/$ca/$subdir/}si;                                                          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 ++;                                                                  $changes ++;
                                                             }                                                              }
                                                               $havecodebase = 1;
                                                         }                                                          }
                                                         $parser[-1]->unget_token($next_token);  
                                                     }                                                      }
                                                     if ($lctag eq 'applet') {                                                      unless ($havecodebase) {
                                                         my $havecodebase=0;  
                                                         foreach my $key (keys(%parms)) {                                                          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) {                                                                  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 ++;                                                                      $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='';                                                  my $newparmstring='';
                                                     foreach my $parkey (keys(%parms)) {                                                  my $endtag='';
                                                         if ($parkey eq '/') {                                                  foreach my $parkey (keys(%parms)) {
                                                             $endtag=' /';                                                      if ($parkey eq '/') {
                                                         } else {                                                          $endtag=' /';
                                                             my $quote=($parms{$parkey}=~/\"/?"'":'"');                                                      } else {
                                                             $newparmstring.=' '.$parkey.'='.$quote.$parms{$parkey}.$quote;                                                          my $quote=($parms{$parkey}=~/\"/?"'":'"');
                                                         }                                                          $newparmstring.=' '.$parkey.'='.$quote.$parms{$parkey}.$quote;
                                                     }                                                      }
                                                     if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }                                                  }
                                                     $outstring.='<'.$tag.$newparmstring.$endtag.'>';                                                  if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }
                                                     if ($lctag eq 'm' || $lctag eq 'answer' || $lctag eq 'display' ||                                                  $outstring.='<'.$tag.$newparmstring.$endtag.'>';
                                                         $lctag eq 'tex') {                                                  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);                                                          $outstring.=&Apache::lonxml::get_all_text_unbalanced('/'.$lctag,\@parser);
                                                     } elsif ($lctag eq 'script') {                                                      } else {
                                                         if ($parms{'type'} eq 'loncapa/perl') {                                                          my $needsupdate;
                                                             $outstring.=&Apache::lonxml::get_all_text_unbalanced('/'.$lctag,\@parser);                                                          my $script = &Apache::lonxml::get_all_text_unbalanced('/'.$lctag,\@parser);
                                                         } else {                                                          if ($script =~ m{\.addMediaSrc\((["'])((?!\1).+)\1\);}) {
                                                             my $needsupdate;                                                              my $src = $2;
                                                             my $script = &Apache::lonxml::get_all_text_unbalanced('/'.$lctag,\@parser);                                                              if ($src =~ m{^\Q/res/$coursedom/$coursenum/\E}si) {
                                                             if ($script =~ m{\.addMediaSrc\((["'])((?!\1).+)\1\);}) {                                                                  $needsupdate = 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;                                                          if ($script =~ /\(document,\s*(['"])script\1,\s*\[([^\]]+)\]\);/s) {
                                                                 my $needsupdate = 1;                                                              my $scriptslist = $2;
                                                                 my @srcs = split(/\s*,\s*/,$scriptslist);                                                              my $needsupdate = 1;
                                                                 foreach my $src (@srcs) {                                                              my @srcs = split(/\s*,\s*/,$scriptslist);
                                                                     if ($src =~ /(["'])(?:(?!\1).)+\.js\1/) {                                                              foreach my $src (@srcs) {
                                                                         my $quote = $1;                                                                  if ($src =~ /(["'])(?:(?!\1).)+\.js\1/) {
                                                                         my ($url) = ($src =~ m/\Q$quote\E([^$quote]+)\Q$quote\E/);                                                                      my $quote = $1;
                                                                         if ($url =~ m{^\Q/res/$coursedom/$coursenum/\E}si) {                                                                      my ($url) = ($src =~ m/\Q$quote\E([^$quote]+)\Q$quote\E/);
                                                                             $needsupdate = 1;                                                                      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 ($script =~ m{loadScript\(\s*(['"])((?:(?!\1).)+\.js)\1,\s*function}is) {
                                                                 if ($src =~ m{^\Q/res/$coursedom/$coursenum/\E}si) {                                                              my $src = $2;
                                                                     $needsupdate = 1;                                                              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;  
                                                         }                                                          }
                                                     }                                                          if ($needsupdate) {
                                                 } elsif ($token->[0] eq 'E') {                                                              $script =~ s{^\Q/res/$coursedom/$coursenum/\E}{/res/$cd/$ca/$subdir/gsi};
                                                     if ($token->[2]) {                                                              $changes ++;
                                                         unless ($token->[1] eq 'allow') {  
                                                             $outstring.='</'.$token->[1].'>';  
                                                         }                                                          }
                                                           $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) {                                          pop(@parser);
                                             if (open(my $fh,'>',$dest)) {                                      }
                                                 print $fh $outstring;                                      if ($changes) {
                                                 close($fh);                                          if (open(my $fh,'>',$dest)) {
                                             }                                              print $fh $outstring;
                                               close($fh);
                                         }                                          }
                                     }                                      }
                                 }                                  }
                             }                              }
                         }                          }
                     } else {  
                         $notopdir = 1;  
                     }                      }
                   } else {
                       $notopdir = 1;
                 }                  }
             }              }
             if ($notopdir) {              if ($notopdir) {
Line 1130  ENDJS Line 1142  ENDJS
         my $chkname = 'copytouser';          my $chkname = 'copytouser';
         my $context = 'crsauthored';          my $context = 'crsauthored';
         my (%subdirs,%files,@dirs_by_depth,@files_by_depth,%parent,%children,%hierarchy,@checked_maps);          my (%subdirs,%files,@dirs_by_depth,@files_by_depth,%parent,%children,%hierarchy,@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)) {          foreach my $key (keys(%subdirs)) {
             next if (($key eq '/') || ($key eq ''));              next if (($key eq '/') || ($key eq ''));
             my @items = split(/\//,$key);              my @items = split(/\//,$key);
Line 1154  ENDJS Line 1166  ENDJS
             }              }
             if (ref($files{$path}) eq 'HASH') {              if (ref($files{$path}) eq 'HASH') {
                 foreach my $file (keys(%{$files{$path}})) {                  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 ($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) {          if ($readonly) {
             $disabled = ' disabled="disabled"';              $disabled = ' disabled="disabled"';
         }          }
Line 1188  ENDJS Line 1204  ENDJS
         $display .= &Apache::loncommon::start_data_table()."\n".          $display .= &Apache::loncommon::start_data_table()."\n".
                     &Apache::loncommon::start_data_table_header_row().                      &Apache::loncommon::start_data_table_header_row().
                     '<th>'.&mt('Copy?').'</th>'.                      '<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";                      &Apache::loncommon::end_data_table_header_row()."\n";
         $count = &recurse_crsauthored(0,\@dirs_by_depth,\@files_by_depth,'/',$startcount,          $count = &recurse_crsauthored(0,\@dirs_by_depth,\@files_by_depth,'/',$startcount,
                                       $count,\$display,\%parent,\%children,$readonly,                                        $count,\$display,\%parent,\%children,$readonly,
                                       $formname,$chkname,\$lastcontainer);                                        $formname,$chkname,\$lastcontainer,\%resfiles);
         $display .= &Apache::loncommon::end_data_table().'</fieldset>';          $display .= &Apache::loncommon::end_data_table().'</fieldset>';
         unless ($readonly) {          unless ($readonly) {
             $display .= '</div><div style="padding:0;clear:both;margin:0;border:0"></div>'.              $display .= '</div><div style="padding:0;clear:both;margin:0;border:0"></div>'.
Line 1209  ENDJS Line 1227  ENDJS
   
 sub recurse_crsauthored {  sub recurse_crsauthored {
     my ($currdepth,$dirs_by_depth,$files_by_depth,$currpath,$startcount,$count,$displayref,      my ($currdepth,$dirs_by_depth,$files_by_depth,$currpath,$startcount,$count,$displayref,
         $parent,$children,$readonly,$formname,$chkname,$lastcontainerref) = @_;          $parent,$children,$readonly,$formname,$chkname,$lastcontainerref,$resfilesref) = @_;
     return $count unless ((ref($dirs_by_depth) eq 'ARRAY') && (ref($files_by_depth) eq 'ARRAY'));      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);      my ($disabled,$hasdirs,$hasfiles,%unique,%dirs,%files);
     if ((ref($dirs_by_depth->[$currdepth]) eq 'HASH') &&      if ((ref($dirs_by_depth->[$currdepth]) eq 'HASH') &&
         (ref($dirs_by_depth->[$currdepth]{$currpath}) eq 'HASH')) {          (ref($dirs_by_depth->[$currdepth]{$currpath}) eq 'HASH')) {
Line 1256  sub recurse_crsauthored { Line 1275  sub recurse_crsauthored {
             for (my $i=0; $i<$currdepth; $i++) {              for (my $i=0; $i<$currdepth; $i++) {
                 $$displayref .= "$whitespace\n";                  $$displayref .= "$whitespace\n";
             }              }
             $$displayref .= '<img '.$icon.' />&nbsp;'.$item.'</td>'.              $$displayref .= '<img '.$icon.' />&nbsp;'.$item.'</td><td>&nbsp;</td><td>&nbsp;</td>'.
                             &Apache::loncommon::end_data_table_row()."\n";                              &Apache::loncommon::end_data_table_row()."\n";
             $count = &recurse_crsauthored($deeper,$dirs_by_depth,$files_by_depth,$newpath,              $count = &recurse_crsauthored($deeper,$dirs_by_depth,$files_by_depth,$newpath,
                                           $startcount,$count,$displayref,$parent,$children,                                            $startcount,$count,$displayref,$parent,$children,
                                           $readonly,$formname,$chkname,$lastcontainerref);                                            $readonly,$formname,$chkname,$lastcontainerref,$resfilesref);
         }          }
         if ($hasfiles && exists($files{$item})) {          if ($hasfiles && exists($files{$item})) {
             $count ++;              $count ++;
Line 1284  sub recurse_crsauthored { Line 1303  sub recurse_crsauthored {
             } else {              } else {
                 $showpath = "/$currpath/";                  $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().              $$displayref .= &Apache::loncommon::start_data_table_row().
                             '<td><input type="checkbox" name="'.$chkname.'" value="'.&escape($showpath.$item).'" '.                              '<td><input type="checkbox" name="'.$chkname.'" value="'.&escape($showpath.$item).'" '.
                             'onclick="javascript:checkResource(document.'.$formname.','."'$currelem'".')" '.                              'onclick="javascript:checkResource(document.'.$formname.','."'$currelem'".')" '.
Line 1292  sub recurse_crsauthored { Line 1317  sub recurse_crsauthored {
                 $$displayref .= "$whitespace\n";                  $$displayref .= "$whitespace\n";
             }              }
             $$displayref .= '<img '.$icon.$alttext.' />&nbsp;'.$item.'</td>'.              $$displayref .= '<img '.$icon.$alttext.' />&nbsp;'.$item.'</td>'.
                               '<td>'.&Apache::lonlocal::locallocaltime($files{$item}).'</td>'.
                               '<td style="text-align: center;">'.$published.'</td>'.
                             &Apache::loncommon::end_data_table_row()."\n";                              &Apache::loncommon::end_data_table_row()."\n";
         }          }
     }      }

Removed from v.1.713  
changed lines
  Added in v.1.714


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