Return to lonclonecourse.pm CVS log

Up to [LON-CAPA] / loncom / interface

- Exclude record of likes/unlikes for discussion posts when cloning course.

    1: # The LearningOnline Network
    2: # routines for clone a course
    3: #
    4: # $Id: lonclonecourse.pm,v 1.9 2012/03/10 02:45:35 raeburn Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: ###
   29: 
   30: package Apache::lonclonecourse;
   31: use LONCAPA;
   32: use Apache::lonnet;
   33: 
   34: # ================================================ Get course directory listing
   35: 
   36: my @output=();
   37: 
   38: sub crsdirlist {
   39:     my ($courseid,$which)=@_;
   40:     @output=();
   41:     return &innercrsdirlist($courseid,$which);
   42: }
   43: 
   44: sub innercrsdirlist {
   45:     my ($courseid,$which,$path)=@_;
   46:     my $dirptr=16384;
   47:     unless ($which) { $which=''; } else { $which.='/'; }
   48:     unless ($path)  { $path=''; } else { $path.='/'; }
   49:     my %crsdata=&Apache::lonnet::coursedescription($courseid);
   50:     my $getpropath = 1;
   51:     my ($dirlistref,$listerror) = 
   52:         &Apache::lonnet::dirlist($which,$crsdata{'domain'},
   53:                                  $crsdata{'num'},$getpropath);
   54:     if (ref($dirlistref) eq 'ARRAY') {
   55:         foreach (@{$dirlistref}) {
   56: 	    unless ($_=~/^\./) {
   57: 	        my @unpackline = split (/\&/,$_);
   58: 	        if ($unpackline[3]&$dirptr) {
   59: # is a directory, recurse
   60: 		    &innercrsdirlist($courseid,$which.$unpackline[0],
   61: 				     $path.$unpackline[0]);
   62: 	        } else { 
   63: # is a file, put into output
   64: 		    push (@output,$path.$unpackline[0]);
   65: 	        }
   66: 	    }
   67:         }
   68:     }
   69:     return @output;
   70: }
   71: 
   72: # ============================================================= Read a userfile
   73: 
   74: sub readfile {
   75:     my ($courseid,$which)=@_;
   76:     my %crsdata=&Apache::lonnet::coursedescription($courseid);
   77:     my $file = &Apache::lonnet::getfile('/uploaded/'.$crsdata{'domain'}.'/'.
   78: 				      $crsdata{'num'}.'/'.$which);
   79:     return $file;
   80: }
   81: 
   82: # ============================================================ Write a userfile
   83: 
   84: sub writefile {
   85:     (my $courseid, my $which,$env{'form.output'})=@_;
   86:     my %crsdata=&Apache::lonnet::coursedescription($courseid);
   87:     my $data = &Apache::lonnet::finishuserfileupload(
   88: 					  $crsdata{'num'},$crsdata{'domain'},
   89: 					  'output',$which);
   90:     return $data;
   91: }
   92: 
   93: # ===================================================================== Rewrite
   94: 
   95: sub rewritefile {
   96:     my ($contents,%rewritehash)=@_;
   97:     foreach my $pattern (keys(%rewritehash)) {
   98: 	my $new=$rewritehash{$pattern};
   99: 	$contents=~s/\Q$pattern\E/$new/gs;
  100:     }
  101:     return $contents;
  102: }
  103: 
  104: # ============================================================= Copy a userfile
  105: 
  106: sub copyfile {
  107:     my ($origcrsid,$newcrsid,$which)=@_;
  108:     unless ($which=~/\.sequence$/) {
  109: 	return &writefile($newcrsid,$which,
  110: 		      &readfile($origcrsid,$which));
  111:     } else {
  112: 	my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
  113: 	my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
  114: 	return &writefile($newcrsid,$which,
  115: 		 &rewritefile(
  116:                      &readfile($origcrsid,$which),
  117: 	    (
  118:        '/uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
  119:     => '/uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/',
  120:        '/public/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
  121:     => '/public/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/',
  122:        '/adm/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
  123:     => '/adm/'.$newcrsdata{'domain'}.'/'.$newcrsdata{'num'}.'/',
  124:             )));
  125:     }
  126: }
  127: 
  128: # =============================================================== Copy a dbfile
  129: 
  130: sub copydb {
  131:     my ($origcrsid,$newcrsid,$which)=@_;
  132:     $which=~s/\.db$//;
  133:     my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
  134:     my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
  135:     my %data=&Apache::lonnet::dump
  136: 	($which,$origcrsdata{'domain'},$origcrsdata{'num'});
  137:     foreach my $key (keys(%data)) {
  138: 	if ($key=~/^internal./) { delete($data{$key}); }
  139:     }
  140:     return &Apache::lonnet::put
  141: 	($which,\%data,$newcrsdata{'domain'},$newcrsdata{'num'});
  142: }
  143: 
  144: # ========================================================== Copy resourcesdata
  145: 
  146: sub copyresourcedb {
  147:     my ($origcrsid,$newcrsid,$date_mode,$date_shift)=@_;
  148:     my $delta=$date_shift*60*60*24;
  149:     my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
  150:     my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
  151:     my %data=&Apache::lonnet::dump
  152: 	('resourcedata',$origcrsdata{'domain'},$origcrsdata{'num'});
  153:     $origcrsid=~s/^\///;
  154:     $origcrsid=~s/\//\_/;
  155:     $newcrsid=~s/^\///;
  156:     $newcrsid=~s/\//\_/;
  157:     my %newdata=();
  158:     undef %newdata;
  159:     my $startdate=$data{$origcrsid.'.0.opendate'};
  160:     if (!$startdate) {
  161: 	# now global start date for assements try the enrollment start
  162: 	my %start=&Apache::lonnet::get('environment',
  163: 				   ['default_enrollment_start_date'],
  164: 				   $origcrsdata{'domain'},$origcrsdata{'num'});
  165: 
  166: 	$startdate = $start{'default_enrollment_start_date'};
  167:     }
  168: # ugly retro fix for broken version of types
  169:     foreach my $key (keys %data) {
  170: 	if ($key=~/\wtype$/) {
  171: 	    my $newkey=$key;
  172: 	    $newkey=~s/type$/\.type/;
  173: 	    $data{$newkey}=$data{$key};
  174: 	    delete $data{$key};
  175: 	}
  176:     }
  177: # adjust symbs
  178:     my $pattern='uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/';
  179:     my $new=    'uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/';
  180:     foreach my $key (keys %data) {
  181: 	if ($key=~/\Q$pattern\E/) {
  182: 	    my $newkey=$key;
  183: 	    $newkey=~s/\Q$pattern\E/$new/;
  184: 	    $data{$newkey}=$data{$key};
  185: 	    delete $data{$key};
  186: 	}
  187:     }
  188: #  transfer hash
  189:     foreach my $key (keys %data) {
  190: 	my $thiskey=$key;
  191: 	$thiskey=~s/^$origcrsid/$newcrsid/;
  192: 	$newdata{$thiskey}=$data{$key};
  193: # date_mode empty or "preserve": transfer dates one-to-one
  194: # date_mode "shift": shift dates by date_shift days
  195: # date_mode other: do not transfer dates
  196:         if (($date_mode) && ($date_mode ne 'preserve')) {
  197: 	    if ($data{$key.'.type'}=~/^date_(start|end)$/) {
  198: 	       if ($date_mode eq 'shift') {
  199: 		  $newdata{$thiskey}=$newdata{$thiskey}+$delta;
  200: 	       } else {
  201: 		  delete($newdata{$thiskey});
  202: 		  delete($newdata{$thiskey.'.type'});
  203: 	       }
  204:             }
  205: 	}
  206:     }
  207:     return &Apache::lonnet::put
  208: 	('resourcedata',\%newdata,$newcrsdata{'domain'},$newcrsdata{'num'});
  209: }
  210: 
  211: # ========================================================== Copy all userfiles
  212: 
  213: sub copyuserfiles {
  214:     my ($origcrsid,$newcrsid)=@_;
  215:     foreach (&crsdirlist($origcrsid,'userfiles')) {
  216: 	if ($_ !~m|^scantron_|) {
  217: 	    &copyfile($origcrsid,$newcrsid,$_);
  218: 	}
  219:     }
  220: }
  221: # ========================================================== Copy all userfiles
  222: 
  223: sub copydbfiles {
  224:     my ($origcrsid,$newcrsid)=@_;
  225: 
  226:     my ($origcrs_discussion) = ($origcrsid=~m|^/(.*)|);
  227:     $origcrs_discussion=~s|/|_|g;
  228:     foreach (&crsdirlist($origcrsid)) {
  229: 	if ($_=~/\.db$/) {
  230: 	    unless 
  231:              ($_=~/^(nohist\_|disclikes|discussiontimes|classlist|versionupdate|resourcedata|\Q$origcrs_discussion\E|slots|slot_reservations|gradingqueue|reviewqueue|CODEs|groupmembership)/) {
  232: 		 &copydb($origcrsid,$newcrsid,$_);
  233: 	     }
  234: 	}
  235:     }
  236: }
  237: 
  238: # ======================================================= Copy all course files
  239: 
  240: sub copycoursefiles {
  241:     my ($origcrsid,$newcrsid,$date_mode,$date_shift)=@_;
  242:     &copyuserfiles($origcrsid,$newcrsid);
  243:     &copydbfiles($origcrsid,$newcrsid);
  244:     &copyresourcedb($origcrsid,$newcrsid,$date_mode,$date_shift);
  245: }
  246: 
  247: 1;