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

Diff for /loncom/interface/londocs.pm between versions 1.490 and 1.491

version 1.490, 2012/07/06 22:46:06 version 1.491, 2012/07/13 13:36:24
Line 715  sub supp_pasteable { Line 715  sub supp_pasteable {
 }  }
   
 sub do_paste_from_buffer {  sub do_paste_from_buffer {
     my ($coursenum,$coursedom,$folder) = @_;      my ($coursenum,$coursedom,$folder,$errors) = @_;
   
     if (!$env{'form.pastemarked'}) {      if (!$env{'form.pastemarked'}) {
         return;          return;
     }      }
   
   # Preparing to paste resource at end of list
       my $url=&LONCAPA::map::qtescape($env{'docs.markedcopy_url'});
       my $title=&LONCAPA::map::qtescape($env{'docs.markedcopy_title'});
   
       my ($is_map,$srcdom,$srcnum,$prefixchg,%before,%after,%mapchanges);
       if ($url=~/\.(page|sequence)$/) {
           $is_map = 1; 
       }
       if ($url =~ m{^/uploaded/($match_domain)/($match_courseid)/([^/]+)}) {
           $srcdom = $1;
           $srcnum = $2;
           my $oldprefix = $3;
           if (($srcdom ne $coursedom) || ($srcnum ne $coursenum)) {
               unless ($env{"user.priv.cm./$srcdom/$srcnum"} =~ /\Q:mdc&F\E/) {
                   return &mt('Paste failed: Item is from a different course which you do not have rights to edit.');
               }
           }
           if (($folder =~ /^supplemental/) && (($oldprefix =~ /^default/) || ($oldprefix eq 'docs'))) {
               $prefixchg = 1;
               %before = ( map => 'default',
                           doc => 'docs');
               %after =  ( map => 'supplemental',
                           doc => 'supplemental' );
           } elsif (($folder =~ /^default/) && ($oldprefix =~ /^supplemental/)) {
               $prefixchg = 1;
               %before = ( map => 'supplemental',
                           doc => 'supplemental');
               %after  = ( map => 'default',
                           doc => 'docs');
           }
       }
   
 # Supplemental content may only include certain types of content  # Supplemental content may only include certain types of content
     if ($folder =~ /^supplemental/) {      if ($folder =~ /^supplemental/) {
         unless (&supp_pasteable($env{'docs.markedcopy_url'})) {          unless (&supp_pasteable($env{'docs.markedcopy_url'})) {
Line 728  sub do_paste_from_buffer { Line 760  sub do_paste_from_buffer {
         }          }
     }      }
   
 # paste resource to end of list  
     my $url=&LONCAPA::map::qtescape($env{'docs.markedcopy_url'});  
     my $title=&LONCAPA::map::qtescape($env{'docs.markedcopy_title'});  
 # Maps need to be copied first  # Maps need to be copied first
     my ($oldurl,%removefrommap,%addedmaps,%rewrites,%copies,%dbcopies,%zombies,%params,      my ($oldurl,%removefrommap,%addedmaps,%rewrites,%retitles,%copies,%dbcopies,%zombies,
         %moves,$srcdom,$srcnum);          %params,%docmoves,%mapmoves);
     $oldurl = $url;      $oldurl = $url;
     if ($url=~/\.(page|sequence)$/) {      if ($is_map) {
         # If pasting a map, check if map contains other maps  # If pasting a map, check if map contains other maps
         &contained_map_check($url,$folder,\%removefrommap,\%addedmaps);  
         if (keys(%addedmaps) > 0) {  
             &reinit_role($coursedom,$coursenum,$env{"course.$env{'request.course.id'}.home"});  
         }  
         my %allmaps;          my %allmaps;
         my $navmap = Apache::lonnavmaps::navmap->new();          &contained_map_check($url,$folder,\%removefrommap,\%addedmaps);
         if (defined($navmap)) {          if ($folder =~ /^default/) {
             foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {              if (keys(%addedmaps) > 0) {
                 $allmaps{$res->src()} = 1;                  &reinit_role($coursedom,$coursenum,$env{"course.$env{'request.course.id'}.home"});
               }
               my $navmap = Apache::lonnavmaps::navmap->new();
               if (defined($navmap)) {
                   foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                       $allmaps{$res->src()} = 1;
                   }
             }              }
         }          }
         if ($url=~ m{^/uploaded/}) {          if ($url=~ m{^/uploaded/}) {
     $title=&mt('Copy of').' '.$title;      $title=&mt('Copy of').' '.$title;
         }          }
  my $newid=$$.int(rand(100)).time;          my $now = time;
    my $suffix=$$.int(rand(100)).$now;
  my ($oldid,$ext) = ($url=~/^(.+)\.(\w+)$/);   my ($oldid,$ext) = ($url=~/^(.+)\.(\w+)$/);
         if ($oldid =~ m{^(/uploaded/$match_domain/$match_courseid/)(\D+)(\d+)$}) {          if ($oldid =~ m{^(/uploaded/$match_domain/$match_courseid/)(\D+)(\d+)$}) {
             my $path = $1;              my $path = $1;
Line 760  sub do_paste_from_buffer { Line 792  sub do_paste_from_buffer {
             if (length($ancestor) > 10) {              if (length($ancestor) > 10) {
                 $ancestor = substr($ancestor,-10,10);                  $ancestor = substr($ancestor,-10,10);
             }              }
             $oldid = $path.$prefix.$ancestor;              my ($newurl,$newid);
               if ($prefixchg) {
                   if ($folder =~ /^supplemental/) {
                       $prefix =~ s/^default/supplemental/;                   
                   } else {
                       $prefix =~ s/^supplemental/default/;
                   }
               }
               if (($srcdom eq $coursedom) && ($srcnum eq $coursenum)) {
                   $newurl = $path.$prefix.$ancestor.$suffix.'.'.$ext;
               } else {
                   $newurl = "/uploaded/$coursedom/$coursenum/$prefix".$now.'.'.$ext;
               }
             my $counter = 0;              my $counter = 0;
             my $newurl=$oldid.$newid.'.'.$ext;  
             my $is_unique = &uniqueness_check($newurl);              my $is_unique = &uniqueness_check($newurl);
             if ($allmaps{$newurl}) {              if ($folder =~ /^default/) {
                 $is_unique = 0;                  if ($allmaps{$newurl}) {
                       $is_unique = 0;
                   }
             }              }
             while (!$is_unique && $allmaps{$newurl} && $counter < 100) {              while (!$is_unique && $allmaps{$newurl} && $counter < 100) {
                 $counter ++;                  $counter ++;
                 $newid ++;                  $suffix ++;
                 $newurl = $oldid.$newid;                  if (($srcdom eq $coursedom) && ($srcnum eq $coursenum)) {
                       $newurl = $path.$prefix.$ancestor.$suffix.'.'.$ext;
                   } else {
                       $newurl = "/uploaded/$coursedom/$coursenum/$prefix".$ancestor.$suffix.'.'.$ext;
                   }
                 $is_unique = &uniqueness_check($newurl);                  $is_unique = &uniqueness_check($newurl);
             }              }
             if ($is_unique) {              if ($is_unique) {
                 if ($path =~ m{^/uploaded/($match_domain)/($match_courseid)/$}) {                  if ($newurl ne $oldurl) {
                     $srcdom = $1;                      $mapchanges{$oldurl} = 1;
                     $srcnum = $2;                  }
                     if (($1 ne $coursedom) && ($2 ne $coursenum)) {                  if (($srcdom ne $coursedom) || ($srcnum ne $coursenum) || ($prefixchg)) {
                         my $srcdom = $1;                      &url_paste_fixups($url,$prefixchg,$coursedom,$coursenum,\%allmaps,
                         my $srcnum = $2;                                        \%rewrites,\%retitles,\%copies,\%dbcopies,\%zombies,
                         if ($env{"user.priv.cm./$srcdom/$srcnum"} =~ /\Q:mdc&F\E/) {                                        \%params,\%mapmoves,\%mapchanges);
                             &url_paste_fixups($oldid,$ext,$coursedom,$coursenum,  
                                               \%allmaps, \%rewrites,\%copies,\%dbcopies,\%zombies,\%params);  
                         } else {  
                             return &mt('Paste failed: Item is from a different course which you do not have rights to edit');  
                         }  
                     }  
                 }                  }
             } else {              } else {
                 if ($url=~/\.page$/) {                  if ($url=~/\.page$/) {
Line 802  sub do_paste_from_buffer { Line 845  sub do_paste_from_buffer {
            &Apache::lonnet::getfile($url));             &Apache::lonnet::getfile($url));
             if ($paste_map_result eq '/adm/notfound.html') {              if ($paste_map_result eq '/adm/notfound.html') {
                 if ($url=~/\.page$/) {                  if ($url=~/\.page$/) {
                     return &mt('Paste failed: an error occurred saving the composite page');                      return &mt('Paste failed: an error occurred saving the composite page.');
                 } else {                  } else {
                     return &mt('Paste failed: an error occurred saving the folder');                      return &mt('Paste failed: an error occurred saving the folder.');
                 }                  }
             }              }
     $url = $newurl;      $url = $newurl;
         } elsif ($url=~m {^/res/}) {          } elsif ($url=~m {^/res/}) {
 # published maps can only exists once, so remove it from paste buffer when done  # published maps can only exists once, so remove it from paste buffer when done
             &Apache::lonnet::delenv('docs.markedcopy');              &Apache::lonnet::delenv('docs.markedcopy');
             if ($allmaps{$url}) {              if ($folder =~ /^default/) {  
                 return &mt('Paste failed: only one instance of a particular published sequence or page is allowed within each course.');                  if ($allmaps{$url}) {
             }                      return &mt('Paste failed: only one instance of a particular published sequence or page is allowed within each course.');
         }                  }
     } elsif ($url =~ m{^/uploaded/($match_domain)/($match_courseid)/}) {  
         if (($1 ne $coursedom) || ($2 ne $coursenum)) {  
             $srcdom = $1;  
             $srcnum = $2;  
             unless ($env{"user.priv.cm./$srcdom/$srcnum"} =~ /\Q:mdc&F\E/) {  
                 return &mt('Paste failed: Item is from a different course which you do not have rights to edit');  
             }              }
         }          }
     }      }
Line 831  sub do_paste_from_buffer { Line 868  sub do_paste_from_buffer {
     my %contents=&Apache::lonnet::dump($db_name,$coursedom,$coursenum);      my %contents=&Apache::lonnet::dump($db_name,$coursedom,$coursenum);
     my $now = time();      my $now = time();
     $db_name =~ s{_\d*$ }{_$now}x;      $db_name =~ s{_\d*$ }{_$now}x;
     my $result=&Apache::lonnet::put($db_name,\%contents,      my $dbresult=&Apache::lonnet::put($db_name,\%contents,
     $coursedom,$coursenum);      $coursedom,$coursenum);
     $url =~ s{/(\d*)/smppg$ }{/$now/smppg}x;              if ($dbresult eq 'ok') {
     $title=&mt('Copy of').' '.$title;                  $url =~ s{/(\d*)/smppg$ }{/$now/smppg}x;
                   $title=&mt('Copy of').' '.$title;
               } else {
                   return &mt('Paste failed: An error occurred when copying the simple page.');
               }
  }   }
     }      }
     my ($relpath,$oldprefix,$prefixchg);  
     if ($url =~ m{^/uploaded/$match_domain/$match_courseid/(docs|supplemental)/(.+)$}) {  
         $oldprefix = $1;  
         $relpath = $2;  
         if (($folder =~ /^supplemental/) && ($oldprefix eq 'docs')) {   
             $prefixchg = 1;  
         } elsif (($folder =~ /^default/) && ($oldprefix eq 'supplemental')) {  
             $prefixchg = 1;  
         }  
     }  
     $title = &LONCAPA::map::qtunescape($title);      $title = &LONCAPA::map::qtunescape($title);
     my $ext='false';      my $ext='false';
     if ($url=~m{^http(|s)://}) { $ext='true'; }      if ($url=~m{^http(|s)://}) { $ext='true'; }
     $url       = &LONCAPA::map::qtunescape($url);      $url       = &LONCAPA::map::qtunescape($url);
 # Now insert the URL at the bottom  # Now insert the URL at the bottom
     my $newidx = &LONCAPA::map::getresidx($url);      my $newidx = &LONCAPA::map::getresidx($url);
     if ($relpath ne '') {  
         my ($prefix,$subdir,$rem) = ($relpath =~ m{^(default|\d+)/(\d+)/(.+)$});  # For uploaded files (excluding pages/sequences) path in copied file is changed
         my ($newloc,$newsubdir) = ($folder =~ /^(default|supplemental)_?(\d*)/);  # if paste is from Main to Supplemental (or vice versa), or if pasting between
         my $newprefix = $newloc;  # courses.
         if ($newloc eq 'default') {  
             $newprefix = 'docs';      unless ($is_map) {
         }          if ($url =~ m{^/uploaded/$match_domain/$match_courseid/(?:docs|supplemental)/(.+)$}) {
         if ($newsubdir eq '') {              my $relpath = $1;
             $newsubdir = 'default';              if ($relpath ne '') {
         }                  my ($prefix,$subdir,$rem) = ($relpath =~ m{^(default|\d+)/(\d+)/(.+)$});
         if (($prefixchg) || ($srcdom ne '') && ($srcnum ne '')) {                  my ($newloc,$newsubdir) = ($folder =~ /^(default|supplemental)_?(\d*)/);
             my $newpath = "$newprefix/$newsubdir/$newidx/$rem";                  my $newprefix = $newloc;
             $url =                  if ($newloc eq 'default') {
                 &Apache::lonclonecourse::writefile($env{'request.course.id'},$newpath,                      $newprefix = 'docs';
                                                    &Apache::lonnet::getfile($oldurl));                  }
             if ($url eq '/adm/notfound.html') {                  if ($newsubdir eq '') {
                 return &mt('Paste failed: an error occurred saving the file.');                      $newsubdir = 'default';
             } else {                  }
                 my ($newsubpath) = ($newpath =~ m{^(.*/)[^/]*$});                  if (($prefixchg) || ($srcdom ne $coursedom) || ($srcnum ne $coursenum)) {
                 $newsubpath =~ s{/+$}{/};                      my $newpath = "$newprefix/$newsubdir/$newidx/$rem";
                 $moves{$oldurl} = $newsubpath;                      $url =
                           &Apache::lonclonecourse::writefile($env{'request.course.id'},$newpath,
                                                              &Apache::lonnet::getfile($oldurl));
                       if ($url eq '/adm/notfound.html') {
                           return &mt('Paste failed: an error occurred saving the file.');
                       } else {
                           my ($newsubpath) = ($newpath =~ m{^(.*/)[^/]*$});
                           $newsubpath =~ s{/+$}{/};
                           $docmoves{$oldurl} = $newsubpath;
                       }
                   }
             }              }
         }          }
     }      }
     my $noparams = 0;      my $result =
     if ((ref($params{$oldurl}) eq 'HASH') && ($relpath ne '') && ($folder =~ /^supplemental/)) {          &apply_fixups($is_map,$prefixchg,$coursedom,$coursenum,$oldurl,$url,
         $noparams = 1;                        \%removefrommap,\%rewrites,\%retitles,\%copies,\%dbcopies,
     }                        \%zombies,\%params,\%docmoves,\%mapmoves,$errors,\%before,\%after);
     &apply_fixups($coursedom,$coursenum,$oldurl,$url,$noparams,\%rewrites,\%copies,      if ($result eq 'ok') {
                   \%dbcopies,\%zombies,\%params,\%moves);          if ($env{'docs.markedcopy_supplemental'}) {
     if ($env{'docs.markedcopy_supplemental'}) {              if ($folder =~ /^supplemental/) {
         if ($folder =~ /^supplemental/) {                  $title = $env{'docs.markedcopy_supplemental'};
             $title = $env{'docs.markedcopy_supplemental'};              } else {
                   (undef,undef,$title) =
                       &Apache::loncommon::parse_supplemental_title($env{'docs.markedcopy_supplemental'});
               }
         } else {          } else {
             (undef,undef,$title) =              if ($folder=~/^supplemental/) {
                 &Apache::loncommon::parse_supplemental_title($env{'docs.markedcopy_supplemental'});                  $title=time.'___&&&___'.$env{'user.name'}.'___&&&___'.
         }                         $env{'user.domain'}.'___&&&___'.$title;
     } else {              }
         if ($folder=~/^supplemental/) {  
            $title=time.'___&&&___'.$env{'user.name'}.'___&&&___'.  
                   $env{'user.domain'}.'___&&&___'.$title;  
         }          }
           $LONCAPA::map::resources[$newidx]= $title.':'.$url.':'.$ext.':normal:res';
           push(@LONCAPA::map::order, $newidx);
     }      }
       return $result;
     $LONCAPA::map::resources[$newidx]= $title.':'.$url.':'.$ext.':normal:res';  
     push(@LONCAPA::map::order, $newidx);  
     return 'ok';  
 # Store the result  
 }  }
   
 sub dbcopy {  sub dbcopy {
Line 979  sub reinit_role { Line 1018  sub reinit_role {
 }  }
   
 sub url_paste_fixups {  sub url_paste_fixups {
     my ($oldurl,$ext,$cdom,$cnum,$allmaps,$rewrites,$copies,$dbcopies,$zombies,$params) = @_;      my ($oldurl,$prefixchg,$cdom,$cnum,$allmaps,$rewrites,$retitles,$copies,
     my $file = &Apache::lonnet::getfile("$oldurl.$ext");          $dbcopies,$zombies,$params,$mapmoves,$mapchanges) = @_;
       my $checktitle;
       if (($prefixchg) &&
           ($oldurl =~ m{^/uploaded/($match_domain)/($match_courseid)/supplemental})) {
           $checktitle = 1;
       }
       my $file = &Apache::lonnet::getfile($oldurl);
     return if ($file eq '-1');      return if ($file eq '-1');
     my $parser = HTML::TokeParser->new(\$file);      my $parser = HTML::TokeParser->new(\$file);
     $parser->attr_encoded(1);      $parser->attr_encoded(1);
       my $changed = 0;
     while (my $token = $parser->get_token) {      while (my $token = $parser->get_token) {
         next if ($token->[0] ne 'S');          next if ($token->[0] ne 'S');
         if ($token->[1] eq 'resource') {          if ($token->[1] eq 'resource') {
             my $ressrc = $token->[2]->{'src'};              my $ressrc = $token->[2]->{'src'};
             next if ($ressrc eq '');              next if ($ressrc eq '');
             next if ($token->[2]->{'type'} eq 'external');  
             my $id = $token->[2]->{'id'};              my $id = $token->[2]->{'id'};
               if ($checktitle) {
                   my $title = $token->[2]->{'title'};
                   if ($title =~ m{\d+\Q___&amp;&amp;&amp;___\E$match_username\Q___&amp;&amp;&amp;___\E$match_domain\Q___&amp;&amp;&amp;___\E(.+)$}) {
                       $retitles->{$oldurl}{$ressrc} = $id;
   
                   }
               }
               next if ($token->[2]->{'type'} eq 'external');
             if ($token->[2]->{'type'} eq 'zombie') {              if ($token->[2]->{'type'} eq 'zombie') {
                 $zombies->{$oldurl}{$ressrc} = $id;                  $zombies->{$oldurl}{$ressrc} = $id;
             } elsif ($ressrc =~ m{^/uploaded/($match_domain)/($match_courseid)/(.+)}) {                  $changed = 1;
               } elsif ($ressrc =~ m{^/uploaded/($match_domain)/($match_courseid)/(.+)$}) {
                 my $srccdom = $1;                  my $srccdom = $1;
                 my $srccnum = $2;                  my $srccnum = $2;
                 my $rem = $3;                  my $rem = $3;
                 if (($srccdom ne $cdom) || ($srccnum ne $cnum)) {                  if (($srccdom ne $cdom) || ($srccnum ne $cnum) || ($prefixchg) ||
                       ($mapchanges->{$oldurl})) {
                     if ($rem =~ /^(default|supplemental)(_?\d*).(sequence|page)$/) {                      if ($rem =~ /^(default|supplemental)(_?\d*).(sequence|page)$/) {
                         $rewrites->{$oldurl}{$ressrc} = $id;                          $rewrites->{$oldurl}{$ressrc} = $id;
                         &url_paste_fixups($ressrc,$3,$cdom,$cnum,$allmaps,$rewrites,$copies,$dbcopies,$zombies,$params);                          $mapchanges->{$ressrc} = 1;
                           unless (&url_paste_fixups($ressrc,$prefixchg,$cdom,$cnum,$allmaps,
                                                     $rewrites,$retitles,$copies,$dbcopies,$zombies,
                                                     $params,$mapmoves,$mapchanges)) {
                               $mapmoves->{$ressrc} = 1;
                           }
                           $changed = 1;
                     } else {                      } else {
                         $rewrites->{$oldurl}{$ressrc} = $id;                          $rewrites->{$oldurl}{$ressrc} = $id;
                         $copies->{$oldurl}{$ressrc} = $id;                          $copies->{$oldurl}{$ressrc} = $id;
                           $changed = 1;
                     }                      }
                 }                  }
             } elsif ($ressrc =~ m{^/adm/($match_domain)/($match_courseid)/(.+)$}) {              } elsif ($ressrc =~ m{^/adm/($match_domain)/($match_courseid)/(.+)$}) {
Line 1012  sub url_paste_fixups { Line 1074  sub url_paste_fixups {
                 if (($srccdom ne $cdom) || ($srccnum ne $cnum)) {                  if (($srccdom ne $cdom) || ($srccnum ne $cnum)) {
                     $rewrites->{$oldurl}{$ressrc} = $id;                      $rewrites->{$oldurl}{$ressrc} = $id;
                     $dbcopies->{$oldurl}{$ressrc} = $id;                      $dbcopies->{$oldurl}{$ressrc} = $id;
                       $changed = 1;
                 }                  }
             } elsif ($ressrc =~ m{^/public/($match_domain)/($match_courseid)/(.+)$}) {              } elsif ($ressrc =~ m{^/public/($match_domain)/($match_courseid)/(.+)$}) {
                 my $srccdom = $1;                  my $srccdom = $1;
Line 1019  sub url_paste_fixups { Line 1082  sub url_paste_fixups {
                 if (($srccdom ne $cdom) || ($srccnum ne $cnum)) {                  if (($srccdom ne $cdom) || ($srccnum ne $cnum)) {
                     $rewrites->{$oldurl}{$ressrc} = $id;                      $rewrites->{$oldurl}{$ressrc} = $id;
                     $dbcopies->{$oldurl}{$ressrc} = $id;                      $dbcopies->{$oldurl}{$ressrc} = $id;
                       $changed = 1;
                 }                  }
             }              }
         } elsif ($token->[1] eq 'param') {          } elsif ($token->[1] eq 'param') {
Line 1032  sub url_paste_fixups { Line 1096  sub url_paste_fixups {
             }              }
         }          }
     }      }
     return;      return $changed;
 }  }
   
 sub apply_fixups {  sub apply_fixups {
     my ($cdom,$cnum,$oldurl,$url,$noparams,$rewrites,$copies,$dbcopies,$zombies,$params,      my ($is_map,$prefixchg,$cdom,$cnum,$oldurl,$url,$removefrommap,$rewrites,
         $moves) = @_;          $retitles,$copies,$dbcopies,$zombies,$params,$docmoves,$mapmoves,$errors,
     my (%newdb,%newdoc);          $before,$after) = @_;
     if (ref($dbcopies->{$oldurl}) eq 'HASH') {      my ($oldsubdir,$newsubdir,$subdirchg);
         foreach my $item (keys(%{$dbcopies->{$oldurl}})) {      if ($is_map) {
             $newdb{$item} = &dbcopy($item);          ($oldsubdir) =
         }              ($oldurl =~ m{^/uploaded/$match_domain/$match_courseid/(?:default|supplemental)_?(\d*)});
     }          if ($oldsubdir eq '') {
     my @allcopies;              $oldsubdir = 'default';
     if (ref($copies->{$oldurl}) eq 'HASH') {          }
         push(@allcopies,keys(%{$copies->{$oldurl}}));          ($newsubdir) =
     }              ($url =~ m{^/uploaded/$match_domain/$match_courseid/(?:default|supplemental)_?(\d*)});
     if ((ref($moves) eq 'HASH') && (exists($moves->{$oldurl}))) {          if ($newsubdir eq '') {
         push(@allcopies,$oldurl);              $newsubdir = 'default';
     }          }
     if (@allcopies > 0) {          if ($oldsubdir ne $newsubdir) {
         foreach my $item (@allcopies) {              $subdirchg = 1;
             my $content = &Apache::lonnet::getfile($item);          }
             unless ($content eq '-1') {      }
                 my $mm = new File::MMagic;      foreach my $key (keys(%{$copies}),keys(%{$docmoves})) {
                 my $mimetype = $mm->checktype_contents($content);          my @allcopies;
                 if ($mimetype eq 'text/html') {          if (ref($copies->{$key}) eq 'HASH') {
                     my (%allfiles,%codebase,$state);              my %added;
                     if (&Apache::lonnet::extract_embedded_items(undef,\%allfiles,\%codebase,\$content) eq 'ok') {              foreach my $innerkey (keys(%{$copies->{$key}})) {
                         my ($numexisting,$numpathchanges,$existing);                  if (($innerkey ne '') && (!$added{$innerkey})) {
                         (undef,$numexisting,$numpathchanges,$existing) =                       push(@allcopies,$innerkey);
                             &Apache::loncommon::ask_for_embedded_content(                      $added{$innerkey} = 1;
                                 '/adm/coursedocs',$state,\%allfiles,\%codebase,                  }
                                 {'error_on_invalid_names'   => 1,              }
                                  'ignore_remote_references' => 1,              undef(%added);
                                  'docs_url'                 => $oldurl,          }
                                  'context'                  => 'paste'});          if ($key eq $oldurl) {
                         if ($numexisting > 0) {              if ((exists($docmoves->{$key}))) {
                             if (ref($existing) eq 'HASH') {                  unless (grep(/^\Q$oldurl\E/,@allcopies)) {
                                 my ($relpath) = ($item =~ m{^(/uploaded/$match_domain/$match_courseid/(?:docs|supplemental)/(?:default|\d+)/.*/)[^/]+$});                      push(@allcopies,$oldurl);
                                 foreach my $dep (keys(%{$existing})) {                  }
                                     $dep =~ s{^\Q$relpath\E}{};              }
                                     my $depfile = $relpath.$dep;          }
                                     my $depstorefn;          if (@allcopies > 0) {
                                     if ((ref($copies->{$oldurl}) eq 'HASH') &&              foreach my $item (@allcopies) {
                                         ($copies->{$oldurl}{$item})) {                  my ($relpath,$fname) = 
                                         $depstorefn = $relpath;                      ($item =~ m{^(/uploaded/$match_domain/$match_courseid/(?:docs|supplemental)/(?:default|\d+)/.*/)([^/]+)$});
                                         $depstorefn =~s{^/\w+/$match_domain/$match_courseid/}{};                  if ($fname ne '') {
                                     } elsif ((ref($moves) eq 'HASH') &&                      my $content = &Apache::lonnet::getfile($item);
                                              (exists($moves->{$oldurl}))) {                      unless ($content eq '-1') {
                                         $depstorefn = $moves->{$oldurl};                          my $storefn;
                                     }                          if (($key eq $oldurl) && (ref($docmoves) eq 'HASH') && (exists($docmoves->{$key}))) {
                                     $depstorefn .= $dep;                              $storefn = $docmoves->{$key};
                                     my $depcontent = &Apache::lonnet::getfile($depfile);                          } else {
                                     unless ($depcontent eq '-1') {                              $storefn = $relpath;
                                         &Apache::lonclonecourse::writefile($env{'request.course.id'},$depstorefn,$depcontent);                              $storefn =~s{^/uploaded/$match_domain/$match_courseid/}{};
                                     }                              if ($prefixchg) {
                                 }                                  $storefn =~ s/^\Q$before->{'doc'}\E/$after->{'doc'}/;
                               }
                               if (($key eq $oldurl) && ($subdirchg)) {
                                   $storefn =~ s{^(docs|supplemental)/\Q$oldsubdir\E/}{$1/$newsubdir/};
                               }
                           }
                           &copy_dependencies($item,$storefn,$relpath,$errors,\$content);
                           my $copyurl = 
                               &Apache::lonclonecourse::writefile($env{'request.course.id'},
                                                                  $storefn.$fname,$content);
                           if ($copyurl eq '/adm/notfound.html') {
                               if ((ref($docmoves) eq 'HASH') && (exists($docmoves->{$oldurl}))) {
                                   return &mt('Paste failed: an error occurred copying the file.');
                               } elsif (ref($errors) eq 'HASH') {
                                   $errors->{$item} = 1;
                             }                              }
                         }                          }
                     }                      }
                 }                  }
                 my $storefn=$item;              }
                 unless (exists($moves->{$oldurl})) {          }
                     $storefn=~s{^/\w+/$match_domain/$match_courseid/}{};      }
                     $newdoc{$item} = &Apache::lonclonecourse::writefile($env{'request.course.id'},$storefn,$content);      foreach my $key (keys(%{$mapmoves})) {
           my $storefn=$key;
           $storefn=~s{^/uploaded/$match_domain/$match_courseid/}{};
           if ($prefixchg) {
               $storefn =~ s/^\Q$before->{'map'}\E/$after->{'map'}/;
           }
           my $mapcontent = &Apache::lonnet::getfile($key);
           if ($mapcontent eq '-1') {
               if (ref($errors) eq 'HASH') {
                   $errors->{$key} = 1;
               }
           } else {
               my $newmap =
                   &Apache::lonclonecourse::writefile($env{'request.course.id'},$storefn,
                                                      $mapcontent);
               if ($newmap eq '/adm/notfound.html') {
                   if (ref($errors) eq 'HASH') {
                       $errors->{$key} = 1;
                 }                  }
             }              }
         }          }
     }      }
     if (((ref($rewrites->{$oldurl}) eq 'HASH') || (ref($zombies->{$oldurl}) eq 'HASH')) ||       my %updates;
         ($noparams) || (keys(%newdb) > 0) || (keys(%newdoc) > 0)) {      if ($is_map) {
         my $map = &Apache::lonnet::getfile($url);          foreach my $key (keys(%{$rewrites})) {
         my $newcontent;             $updates{$key} = 1;
         unless ($map eq '-1') {          }
             my $parser = HTML::TokeParser->new(\$map);          foreach my $key (keys(%{$zombies})) {
             $parser->attr_encoded(1);             $updates{$key} = 1;
             while (my $token = $parser->get_token) {          }
                 if ($token->[0] eq 'S') {          foreach my $key (keys(%{$removefrommap})) {
                     next if ($token->[2]->{'type'} eq 'zombie');             $updates{$key} = 1;
                     next if (($token->[1] eq 'param') && $noparams);          } 
                     if ($token->[1] eq 'resource') {          foreach my $key (keys(%{$dbcopies})) {
                         my $src = $token->[2]->{'src'};             $updates{$key} = 1;
                         my $id = $token->[2]->{'id'};          }
                         if (($rewrites->{$oldurl}{$src} eq $id) || ($newdb{$src} ne '')          foreach my $key (keys(%{$retitles})) {
                             || ($newdoc{$src} ne '')) {             $updates{$key} = 1;
                             if (ref($rewrites->{$oldurl}) eq 'HASH') {          }
                                 if ($rewrites->{$oldurl}{$src} eq $id) {          foreach my $key (keys(%updates)) {
                                     $token->[2]->{'src'} =~ s{^(/uploaded|adm|public)/$match_domain/$match_courseid/}{$1/$cdom/$cnum};              my (%torewrite,%toretitle,%toremove,%zombie,%newdb);
               if (ref($rewrites->{$key}) eq 'HASH') {
                   %torewrite = %{$rewrites->{$key}};
               }
               if (ref($retitles->{$key}) eq 'HASH') {
                   %toretitle = %{$retitles->{$key}};
               }
               if (ref($removefrommap->{$key}) eq 'HASH') {
                   %toremove = %{$removefrommap->{$key}};
               }
               if (ref($zombies->{$key}) eq 'HASH') {
                   %zombie = %{$zombies->{$key}};
               }
               if (ref($dbcopies->{$key}) eq 'HASH') {
                   foreach my $item (keys(%{$dbcopies->{$key}})) {
                       $newdb{$item} = &dbcopy($item);
                   }
               }
               my $map = &Apache::lonnet::getfile($key);
               my $newcontent;
               if ($map eq '-1') {
                   return &mt('Paste failed: an error occurred reading a folder or page: [_1].',$key);
               } else {
                   my $parser = HTML::TokeParser->new(\$map);
                   $parser->attr_encoded(1);
                   while (my $token = $parser->get_token) {
                       if ($token->[0] eq 'S') {
                           if ($token->[2]->{'type'} eq 'zombie') {
                               next if (($token->[2]->{'src'} ne '') &&
                                        ($zombie{$token->[2]->{'src'}} eq $token->[2]->{'id'}));
                           }
                           if ($token->[1] eq 'resource') {
                               my $src = $token->[2]->{'src'};
                               my $id = $token->[2]->{'id'};
                               my $title = $token->[2]->{'title'};
                               my $changed;
                               if ((exists($toretitle{$src})) && ($toretitle{$src} eq $id)) {
                                   if ($title =~ m{^\d+\Q___&amp;&amp;&amp;___\E$match_username\Q___&amp;&amp;&amp;___\E$match_domain\Q___&amp;&amp;&amp;___\E(.+)$}) {
                                       $token->[2]->{'title'} = $1;
                                       $changed = 1;
                                 }                                  }
                               }
                               if ((exists($torewrite{$src})) && ($torewrite{$src} eq $id)) {
                                   $src =~ s{^/(uploaded|adm|public)/$match_domain/$match_courseid/}{/$1/$cdom/$cnum/};
                                   if ($src =~ m{^/uploaded/}) {
                                       if ($prefixchg) {
                                           if ($src =~ /\.(page|sequence)$/) {
                                               $src =~ s#^(/uploaded/$match_domain/$match_courseid/)\Q$before->{'map'}\E#$1$after->{'map'}#;
                                           } else {
                                               $src =~ s#^(/uploaded/$match_domain/$match_courseid/)\Q$before->{'doc'}\E#$1$after->{'doc'}#;
                                           }
                                       }
                                       if (($key eq $oldurl) && ($src !~ /\.(page|sequence)$/) && ($subdirchg)) {
                                           $src =~ s{^(/uploaded/$match_domain/$match_courseid/\w+/)\Q$oldsubdir\E}{$1$newsubdir};
                                       }
                                   }
                                   $token->[2]->{'src'} = $src;
                                   $changed = 1;
                             } elsif ($newdb{$src} ne '') {                              } elsif ($newdb{$src} ne '') {
                                 $token->[2]->{'src'} = $newdb{$src};                                  $token->[2]->{'src'} = $newdb{$src};
                                   $changed = 1;
                             }                              }
                             $newcontent .= "<$token->[1] ";                               if ($changed) {
                             foreach my $attr (@{$token->[3]}) {                                  $newcontent .= "<$token->[1]";
                                 $newcontent .=  ' '.$attr.'="'.$token->[2]->{$attr},'"'                                  foreach my $attr (@{$token->[3]}) {
                                       if ($attr =~ /^\w+$/) {
                                           $newcontent .=  ' '.$attr.'="'.$token->[2]->{$attr}.'"';
                                       }
                                   }
                                   $newcontent .= ' />'."\n";
                               } else {
                                   $newcontent .= $token->[4]."\n";
                             }                              }
                             $newcontent .= ' />';                          } elsif (($token->[2]->{'id'} ne '') &&
                                    (exists($toremove{$token->[2]->{'id'}}))) {
                               next;
                         } else {                          } else {
                             $newcontent .= $token->[4]."\n";                              $newcontent .= $token->[4]."\n";
                         }                          }
                       } elsif ($token->[0] eq 'E') {
                           $newcontent .= $token->[2]."\n";
                       }
                   }
               }
               my $storefn;
               if ($key eq $oldurl) {
                   $storefn = $url;
                   $storefn=~s{^/uploaded/$match_domain/$match_courseid/}{};
               } else {
                   $storefn = $key;
                   $storefn=~s{^/uploaded/$match_domain/$match_courseid/}{};
                   if ($prefixchg) {
                       $storefn =~ s/^\Q$before->{'map'}\E/$after->{'map'}/;
                   }
               }
               my $newmapurl =
                   &Apache::lonclonecourse::writefile($env{'request.course.id'},$storefn,
                                                      $newcontent);
               if ($newmapurl eq '/adm/notfound.html') {
                   return &mt('Paste failed: an error occurred saving the folder or page.');
               }
           }
       }
       return 'ok';
   }
   
   sub copy_dependencies {
       my ($item,$storefn,$relpath,$errors,$contentref) = @_;
       my $content;
       if (ref($contentref)) {
           $content = $$contentref;
       } else {
           $content = &Apache::lonnet::getfile($item);
       }
       unless ($content eq '-1') {
           my $mm = new File::MMagic;
           my $mimetype = $mm->checktype_contents($content);
           if ($mimetype eq 'text/html') {
               my (%allfiles,%codebase,$state);
               my $res = &Apache::lonnet::extract_embedded_items(undef,\%allfiles,\%codebase,\$content);
               if ($res eq 'ok') {
                   my ($numexisting,$numpathchanges,$existing);
                   (undef,$numexisting,$numpathchanges,$existing) =
                       &Apache::loncommon::ask_for_embedded_content(
                           '/adm/coursedocs',$state,\%allfiles,\%codebase,
                           {'error_on_invalid_names'   => 1,
                            'ignore_remote_references' => 1,
                            'docs_url'                 => $item,
                            'context'                  => 'paste'});
                   if ($numexisting > 0) {
                       if (ref($existing) eq 'HASH') {
                           foreach my $dep (keys(%{$existing})) {
                               my $depfile = $dep;
                               unless ($depfile =~ m{^\Q$relpath\E}) {
                                   $depfile = $relpath.$dep;
                               }
                               my $depcontent = &Apache::lonnet::getfile($depfile);
                               unless ($depcontent eq '-1') {
                                   my $storedep = $dep;
                                   $storedep =~ s{^\Q$relpath\E}{};
                                   my $dep_url =
                                       &Apache::lonclonecourse::writefile(
                                           $env{'request.course.id'},
                                           $storefn.$storedep,$depcontent);
                                   if ($dep_url eq '/adm/notfound.html') {
                                       if (ref($errors) eq 'HASH') {
                                           $errors->{$depfile} = 1;
                                       }
                                   } else {
                                       &copy_dependencies($depfile,$storefn,$relpath,$errors,\$depcontent);
                                   }
                               }
                           }
                     }                      }
                 } elsif ($token->[0] eq 'E') {  
                     $newcontent .= $token->[2]."\n";  
                 }                  }
             }              }
         }          }
         my $storefn=$url;  
         $storefn=~s{^/\w+/$match_domain/$match_courseid/}{};  
         my $storeres =  
             &Apache::lonclonecourse::writefile($env{'request.course.id'},$storefn,  
                                                $newcontent);  
     }      }
     return;      return;
 }  }
Line 1267  sub editor { Line 1495  sub editor {
  }   }
   
  if ($env{'form.pastemarked'}) {   if ($env{'form.pastemarked'}) {
               my %paste_errors;
             my $paste_res =              my $paste_res =
                 &do_paste_from_buffer($coursenum,$coursedom,$folder);                  &do_paste_from_buffer($coursenum,$coursedom,$folder,\%paste_errors);
             if ($paste_res eq 'ok') {              if ($paste_res eq 'ok') {
   # Store the result
                 ($errtext,$fatal) = &storemap($coursenum,$coursedom,$folder.'.'.$container);                  ($errtext,$fatal) = &storemap($coursenum,$coursedom,$folder.'.'.$container);
                 return $errtext if ($fatal);                  return $errtext if ($fatal);
             } elsif ($paste_res ne '') {              } elsif ($paste_res ne '') {
                 $r->print('<p><span class="LC_error">'.$paste_res.'</span></p>');                  $r->print('<p><span class="LC_error">'.$paste_res.'</span></p>');
             }              }
               if (keys(%paste_errors) > 0) {
                   $r->print('<p span class="LC_warning">'."\n".
                             &mt('The following files are either dependencies of a web page or references within a folder and/or composite page which could not be copied during the paste operation:')."\n".
                             '<ul>'."\n");
                   foreach my $key (sort(keys(%paste_errors))) {
                       $r->print('<li>'.$key.'</li>'."\n");
                   }
                   $r->print('</ul></p>'."\n");
               }
  }   }
   
  $r->print($upload_output);   $r->print($upload_output);
Removed from v.1.490  
changed lines
  Added in v.1.491

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