[LON-CAPA-cvs] cvs: loncom /interface londocs.pm

raeburn raeburn at source.lon-capa.org
Fri Jul 13 09:36:24 EDT 2012


raeburn		Fri Jul 13 13:36:24 2012 EDT

  Modified files:              
    /loncom/interface	londocs.pm 
  Log:
  - Using paste buffer in Content Editor
    (a) to paste content from a different course
       - Checking for mdc priv in source course before uniqueness check etc.
    (b) pasting from Main to Supplemental and vice versa
       - modify subdirectory docs <-> supplemental
       - modify title in map to remove special "&&&___" entries 
         when moving Supplelemtal -> Main
    Code used to check for dependencies in an uploaded web page (and copy them)
    moved to separate (recursive) routine -- &copy_dependencies().
    -- work in progres --
  
  
-------------- next part --------------
Index: loncom/interface/londocs.pm
diff -u loncom/interface/londocs.pm:1.490 loncom/interface/londocs.pm:1.491
--- loncom/interface/londocs.pm:1.490	Fri Jul  6 22:46:06 2012
+++ loncom/interface/londocs.pm	Fri Jul 13 13:36:24 2012
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Documents
 #
-# $Id: londocs.pm,v 1.490 2012/07/06 22:46:06 raeburn Exp $
+# $Id: londocs.pm,v 1.491 2012/07/13 13:36:24 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -715,12 +715,44 @@
 }
 
 sub do_paste_from_buffer {
-    my ($coursenum,$coursedom,$folder) = @_;
+    my ($coursenum,$coursedom,$folder,$errors) = @_;
 
     if (!$env{'form.pastemarked'}) {
         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
     if ($folder =~ /^supplemental/) {
         unless (&supp_pasteable($env{'docs.markedcopy_url'})) {
@@ -728,30 +760,30 @@
         }
     }
 
-# 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
-    my ($oldurl,%removefrommap,%addedmaps,%rewrites,%copies,%dbcopies,%zombies,%params,
-        %moves,$srcdom,$srcnum);
+    my ($oldurl,%removefrommap,%addedmaps,%rewrites,%retitles,%copies,%dbcopies,%zombies,
+        %params,%docmoves,%mapmoves);
     $oldurl = $url;
-    if ($url=~/\.(page|sequence)$/) {
-        # 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"});
-        }
+    if ($is_map) {
+# If pasting a map, check if map contains other maps
         my %allmaps;
-        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;
+        &contained_map_check($url,$folder,\%removefrommap,\%addedmaps);
+        if ($folder =~ /^default/) {
+            if (keys(%addedmaps) > 0) {
+                &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/}) {
 	    $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+)$/);
         if ($oldid =~ m{^(/uploaded/$match_domain/$match_courseid/)(\D+)(\d+)$}) {
             my $path = $1;
@@ -760,33 +792,44 @@
             if (length($ancestor) > 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 $newurl=$oldid.$newid.'.'.$ext;
             my $is_unique = &uniqueness_check($newurl);
-            if ($allmaps{$newurl}) {
-                $is_unique = 0;
+            if ($folder =~ /^default/) {
+                if ($allmaps{$newurl}) {
+                    $is_unique = 0;
+                }
             }
             while (!$is_unique && $allmaps{$newurl} && $counter < 100) {
                 $counter ++;
-                $newid ++;
-                $newurl = $oldid.$newid;
+                $suffix ++;
+                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);
             }
             if ($is_unique) {
-                if ($path =~ m{^/uploaded/($match_domain)/($match_courseid)/$}) {
-                    $srcdom = $1;
-                    $srcnum = $2;
-                    if (($1 ne $coursedom) && ($2 ne $coursenum)) {
-                        my $srcdom = $1;
-                        my $srcnum = $2;
-                        if ($env{"user.priv.cm./$srcdom/$srcnum"} =~ /\Q:mdc&F\E/) {
-                            &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');
-                        }
-                    }
+                if ($newurl ne $oldurl) {
+                    $mapchanges{$oldurl} = 1;
+                }
+                if (($srcdom ne $coursedom) || ($srcnum ne $coursenum) || ($prefixchg)) {
+                    &url_paste_fixups($url,$prefixchg,$coursedom,$coursenum,\%allmaps,
+                                      \%rewrites,\%retitles,\%copies,\%dbcopies,\%zombies,
+                                      \%params,\%mapmoves,\%mapchanges);
                 }
             } else {
                 if ($url=~/\.page$/) {
@@ -802,25 +845,19 @@
 					           &Apache::lonnet::getfile($url));
             if ($paste_map_result eq '/adm/notfound.html') {
                 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 {
-                    return &mt('Paste failed: an error occurred saving the folder');
+                    return &mt('Paste failed: an error occurred saving the folder.');
                 }
             }
 	    $url = $newurl;
         } elsif ($url=~m {^/res/}) {
 # published maps can only exists once, so remove it from paste buffer when done
             &Apache::lonnet::delenv('docs.markedcopy');
-            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');
+            if ($folder =~ /^default/) {  
+                if ($allmaps{$url}) {
+                    return &mt('Paste failed: only one instance of a particular published sequence or page is allowed within each course.');
+                }
             }
         }
     }
@@ -831,76 +868,78 @@
 	    my %contents=&Apache::lonnet::dump($db_name,$coursedom,$coursenum);
 	    my $now = time();
 	    $db_name =~ s{_\d*$ }{_$now}x;
-	    my $result=&Apache::lonnet::put($db_name,\%contents,
+	    my $dbresult=&Apache::lonnet::put($db_name,\%contents,
 					    $coursedom,$coursenum);
-	    $url =~ s{/(\d*)/smppg$ }{/$now/smppg}x;
-	    $title=&mt('Copy of').' '.$title;
+            if ($dbresult eq 'ok') {
+                $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);
     my $ext='false';
     if ($url=~m{^http(|s)://}) { $ext='true'; }
     $url       = &LONCAPA::map::qtunescape($url);
 # Now insert the URL at the bottom
     my $newidx = &LONCAPA::map::getresidx($url);
-    if ($relpath ne '') {
-        my ($prefix,$subdir,$rem) = ($relpath =~ m{^(default|\d+)/(\d+)/(.+)$});
-        my ($newloc,$newsubdir) = ($folder =~ /^(default|supplemental)_?(\d*)/);
-        my $newprefix = $newloc;
-        if ($newloc eq 'default') {
-            $newprefix = 'docs';
-        }
-        if ($newsubdir eq '') {
-            $newsubdir = 'default';
-        }
-        if (($prefixchg) || ($srcdom ne '') && ($srcnum ne '')) {
-            my $newpath = "$newprefix/$newsubdir/$newidx/$rem";
-            $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{/+$}{/};
-                $moves{$oldurl} = $newsubpath;
+
+# For uploaded files (excluding pages/sequences) path in copied file is changed
+# if paste is from Main to Supplemental (or vice versa), or if pasting between
+# courses.
+
+    unless ($is_map) {
+        if ($url =~ m{^/uploaded/$match_domain/$match_courseid/(?:docs|supplemental)/(.+)$}) {
+            my $relpath = $1;
+            if ($relpath ne '') {
+                my ($prefix,$subdir,$rem) = ($relpath =~ m{^(default|\d+)/(\d+)/(.+)$});
+                my ($newloc,$newsubdir) = ($folder =~ /^(default|supplemental)_?(\d*)/);
+                my $newprefix = $newloc;
+                if ($newloc eq 'default') {
+                    $newprefix = 'docs';
+                }
+                if ($newsubdir eq '') {
+                    $newsubdir = 'default';
+                }
+                if (($prefixchg) || ($srcdom ne $coursedom) || ($srcnum ne $coursenum)) {
+                    my $newpath = "$newprefix/$newsubdir/$newidx/$rem";
+                    $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;
-    if ((ref($params{$oldurl}) eq 'HASH') && ($relpath ne '') && ($folder =~ /^supplemental/)) {
-        $noparams = 1;
-    }
-    &apply_fixups($coursedom,$coursenum,$oldurl,$url,$noparams,\%rewrites,\%copies,
-                  \%dbcopies,\%zombies,\%params,\%moves);
-    if ($env{'docs.markedcopy_supplemental'}) {
-        if ($folder =~ /^supplemental/) {
-            $title = $env{'docs.markedcopy_supplemental'};
+    my $result =
+        &apply_fixups($is_map,$prefixchg,$coursedom,$coursenum,$oldurl,$url,
+                      \%removefrommap,\%rewrites,\%retitles,\%copies,\%dbcopies,
+                      \%zombies,\%params,\%docmoves,\%mapmoves,$errors,\%before,\%after);
+    if ($result eq 'ok') {
+        if ($env{'docs.markedcopy_supplemental'}) {
+            if ($folder =~ /^supplemental/) {
+                $title = $env{'docs.markedcopy_supplemental'};
+            } else {
+                (undef,undef,$title) =
+                    &Apache::loncommon::parse_supplemental_title($env{'docs.markedcopy_supplemental'});
+            }
         } else {
-            (undef,undef,$title) =
-                &Apache::loncommon::parse_supplemental_title($env{'docs.markedcopy_supplemental'});
-        }
-    } else {
-        if ($folder=~/^supplemental/) {
-           $title=time.'___&&&___'.$env{'user.name'}.'___&&&___'.
-                  $env{'user.domain'}.'___&&&___'.$title;
+            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);
     }
-
-    $LONCAPA::map::resources[$newidx]= 	$title.':'.$url.':'.$ext.':normal:res';
-    push(@LONCAPA::map::order, $newidx);
-    return 'ok';
-# Store the result
+    return $result;
 }
 
 sub dbcopy {
@@ -979,31 +1018,54 @@
 }
 
 sub url_paste_fixups {
-    my ($oldurl,$ext,$cdom,$cnum,$allmaps,$rewrites,$copies,$dbcopies,$zombies,$params) = @_;
-    my $file = &Apache::lonnet::getfile("$oldurl.$ext");
+    my ($oldurl,$prefixchg,$cdom,$cnum,$allmaps,$rewrites,$retitles,$copies,
+        $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');
     my $parser = HTML::TokeParser->new(\$file);
     $parser->attr_encoded(1);
+    my $changed = 0;
     while (my $token = $parser->get_token) {
         next if ($token->[0] ne 'S');
         if ($token->[1] eq 'resource') {
             my $ressrc = $token->[2]->{'src'};
             next if ($ressrc eq '');
-            next if ($token->[2]->{'type'} eq 'external');
             my $id = $token->[2]->{'id'};
+            if ($checktitle) {
+                my $title = $token->[2]->{'title'};
+                if ($title =~ m{\d+\Q___&&&___\E$match_username\Q___&&&___\E$match_domain\Q___&&&___\E(.+)$}) {
+                    $retitles->{$oldurl}{$ressrc} = $id;
+
+                }
+            }
+            next if ($token->[2]->{'type'} eq 'external');
             if ($token->[2]->{'type'} eq 'zombie') {
                 $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 $srccnum = $2;
                 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)$/) {
                         $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 {
                         $rewrites->{$oldurl}{$ressrc} = $id;
                         $copies->{$oldurl}{$ressrc} = $id;
+                        $changed = 1;
                     }
                 }
             } elsif ($ressrc =~ m{^/adm/($match_domain)/($match_courseid)/(.+)$}) {
@@ -1012,6 +1074,7 @@
                 if (($srccdom ne $cdom) || ($srccnum ne $cnum)) {
                     $rewrites->{$oldurl}{$ressrc} = $id;
                     $dbcopies->{$oldurl}{$ressrc} = $id;
+                    $changed = 1;
                 }
             } elsif ($ressrc =~ m{^/public/($match_domain)/($match_courseid)/(.+)$}) {
                 my $srccdom = $1;
@@ -1019,6 +1082,7 @@
                 if (($srccdom ne $cdom) || ($srccnum ne $cnum)) {
                     $rewrites->{$oldurl}{$ressrc} = $id;
                     $dbcopies->{$oldurl}{$ressrc} = $id;
+                    $changed = 1;
                 }
             }
         } elsif ($token->[1] eq 'param') {
@@ -1032,117 +1096,281 @@
             }
         }
     }
-    return;
+    return $changed;
 }
 
 sub apply_fixups {
-    my ($cdom,$cnum,$oldurl,$url,$noparams,$rewrites,$copies,$dbcopies,$zombies,$params,
-        $moves) = @_;
-    my (%newdb,%newdoc);
-    if (ref($dbcopies->{$oldurl}) eq 'HASH') {
-        foreach my $item (keys(%{$dbcopies->{$oldurl}})) {
-            $newdb{$item} = &dbcopy($item);
-        }
-    }
-    my @allcopies;
-    if (ref($copies->{$oldurl}) eq 'HASH') {
-        push(@allcopies,keys(%{$copies->{$oldurl}}));
-    }
-    if ((ref($moves) eq 'HASH') && (exists($moves->{$oldurl}))) {
-        push(@allcopies,$oldurl);
-    }
-    if (@allcopies > 0) {
-        foreach my $item (@allcopies) {
-            my $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);
-                    if (&Apache::lonnet::extract_embedded_items(undef,\%allfiles,\%codebase,\$content) 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'                 => $oldurl,
-                                 'context'                  => 'paste'});
-                        if ($numexisting > 0) {
-                            if (ref($existing) eq 'HASH') {
-                                my ($relpath) = ($item =~ m{^(/uploaded/$match_domain/$match_courseid/(?:docs|supplemental)/(?:default|\d+)/.*/)[^/]+$});
-                                foreach my $dep (keys(%{$existing})) {
-                                    $dep =~ s{^\Q$relpath\E}{};
-                                    my $depfile = $relpath.$dep;
-                                    my $depstorefn;
-                                    if ((ref($copies->{$oldurl}) eq 'HASH') &&
-                                        ($copies->{$oldurl}{$item})) {
-                                        $depstorefn = $relpath;
-                                        $depstorefn =~s{^/\w+/$match_domain/$match_courseid/}{};
-                                    } elsif ((ref($moves) eq 'HASH') &&
-                                             (exists($moves->{$oldurl}))) {
-                                        $depstorefn = $moves->{$oldurl};
-                                    }
-                                    $depstorefn .= $dep;
-                                    my $depcontent = &Apache::lonnet::getfile($depfile);
-                                    unless ($depcontent eq '-1') {
-                                        &Apache::lonclonecourse::writefile($env{'request.course.id'},$depstorefn,$depcontent);
-                                    }
-                                }
+    my ($is_map,$prefixchg,$cdom,$cnum,$oldurl,$url,$removefrommap,$rewrites,
+        $retitles,$copies,$dbcopies,$zombies,$params,$docmoves,$mapmoves,$errors,
+        $before,$after) = @_;
+    my ($oldsubdir,$newsubdir,$subdirchg);
+    if ($is_map) {
+        ($oldsubdir) =
+            ($oldurl =~ m{^/uploaded/$match_domain/$match_courseid/(?:default|supplemental)_?(\d*)});
+        if ($oldsubdir eq '') {
+            $oldsubdir = 'default';
+        }
+        ($newsubdir) =
+            ($url =~ m{^/uploaded/$match_domain/$match_courseid/(?:default|supplemental)_?(\d*)});
+        if ($newsubdir eq '') {
+            $newsubdir = 'default';
+        }
+        if ($oldsubdir ne $newsubdir) {
+            $subdirchg = 1;
+        }
+    }
+    foreach my $key (keys(%{$copies}),keys(%{$docmoves})) {
+        my @allcopies;
+        if (ref($copies->{$key}) eq 'HASH') {
+            my %added;
+            foreach my $innerkey (keys(%{$copies->{$key}})) {
+                if (($innerkey ne '') && (!$added{$innerkey})) {
+                    push(@allcopies,$innerkey);
+                    $added{$innerkey} = 1;
+                }
+            }
+            undef(%added);
+        }
+        if ($key eq $oldurl) {
+            if ((exists($docmoves->{$key}))) {
+                unless (grep(/^\Q$oldurl\E/, at allcopies)) {
+                    push(@allcopies,$oldurl);
+                }
+            }
+        }
+        if (@allcopies > 0) {
+            foreach my $item (@allcopies) {
+                my ($relpath,$fname) = 
+                    ($item =~ m{^(/uploaded/$match_domain/$match_courseid/(?:docs|supplemental)/(?:default|\d+)/.*/)([^/]+)$});
+                if ($fname ne '') {
+                    my $content = &Apache::lonnet::getfile($item);
+                    unless ($content eq '-1') {
+                        my $storefn;
+                        if (($key eq $oldurl) && (ref($docmoves) eq 'HASH') && (exists($docmoves->{$key}))) {
+                            $storefn = $docmoves->{$key};
+                        } else {
+                            $storefn = $relpath;
+                            $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')) || 
-        ($noparams) || (keys(%newdb) > 0) || (keys(%newdoc) > 0)) {
-        my $map = &Apache::lonnet::getfile($url);
-        my $newcontent;
-        unless ($map eq '-1') {
-            my $parser = HTML::TokeParser->new(\$map);
-            $parser->attr_encoded(1);
-            while (my $token = $parser->get_token) {
-                if ($token->[0] eq 'S') {
-                    next if ($token->[2]->{'type'} eq 'zombie');
-                    next if (($token->[1] eq 'param') && $noparams);
-                    if ($token->[1] eq 'resource') {
-                        my $src = $token->[2]->{'src'};
-                        my $id = $token->[2]->{'id'};
-                        if (($rewrites->{$oldurl}{$src} eq $id) || ($newdb{$src} ne '')
-                            || ($newdoc{$src} ne '')) {
-                            if (ref($rewrites->{$oldurl}) eq 'HASH') {
-                                if ($rewrites->{$oldurl}{$src} eq $id) {
-                                    $token->[2]->{'src'} =~ s{^(/uploaded|adm|public)/$match_domain/$match_courseid/}{$1/$cdom/$cnum};
+    my %updates;
+    if ($is_map) {
+        foreach my $key (keys(%{$rewrites})) {
+           $updates{$key} = 1;
+        }
+        foreach my $key (keys(%{$zombies})) {
+           $updates{$key} = 1;
+        }
+        foreach my $key (keys(%{$removefrommap})) {
+           $updates{$key} = 1;
+        } 
+        foreach my $key (keys(%{$dbcopies})) {
+           $updates{$key} = 1;
+        }
+        foreach my $key (keys(%{$retitles})) {
+           $updates{$key} = 1;
+        }
+        foreach my $key (keys(%updates)) {
+            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___&&&___\E$match_username\Q___&&&___\E$match_domain\Q___&&&___\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 '') {
                                 $token->[2]->{'src'} = $newdb{$src};
+                                $changed = 1;
                             }
-                            $newcontent .= "<$token->[1] "; 
-                            foreach my $attr (@{$token->[3]}) {
-                                $newcontent .=  ' '.$attr.'="'.$token->[2]->{$attr},'"'
+                            if ($changed) {
+                                $newcontent .= "<$token->[1]";
+                                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 {
                             $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;
 }
@@ -1267,14 +1495,25 @@
 	}
 
 	if ($env{'form.pastemarked'}) {
+            my %paste_errors;
             my $paste_res =
-                &do_paste_from_buffer($coursenum,$coursedom,$folder);
+                &do_paste_from_buffer($coursenum,$coursedom,$folder,\%paste_errors);
             if ($paste_res eq 'ok') {
+# Store the result
                 ($errtext,$fatal) = &storemap($coursenum,$coursedom,$folder.'.'.$container);
                 return $errtext if ($fatal);
             } elsif ($paste_res ne '') {
                 $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);


More information about the LON-CAPA-cvs mailing list