Return to lonclonecourse.pm CVS log

Up to [LON-CAPA] / loncom / interface

Bug 5586
Need to replace old course domain/number with new in URLs in .sequence files which point to group home pages and group aboutme pages (give a listing of viewable group files).

    1: # The LearningOnline Network
    2: # routines for clone a course
    3: #
    4: # $Id: lonclonecourse.pm,v 1.4 2008/01/18 17:51:18 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 @listing=&Apache::lonnet::dirlist
   51: 	($which,$crsdata{'domain'},$crsdata{'num'},
   52: 	 &propath($crsdata{'domain'},$crsdata{'num'}));
   53:     foreach (@listing) {
   54: 	unless ($_=~/^\./) {
   55: 	    my @unpackline = split (/\&/,$_);
   56: 	    if ($unpackline[3]&$dirptr) {
   57: # is a directory, recurse
   58: 		&innercrsdirlist($courseid,$which.$unpackline[0],
   59: 				            $path.$unpackline[0]);
   60: 	    } else { 
   61: # is a file, put into output
   62: 		push (@output,$path.$unpackline[0]);
   63: 	    }
   64: 	}
   65:     }
   66:     return @output;
   67: }
   68: 
   69: # ============================================================= Read a userfile
   70: 
   71: sub readfile {
   72:     my ($courseid,$which)=@_;
   73:     my %crsdata=&Apache::lonnet::coursedescription($courseid);
   74:     my $file = &Apache::lonnet::getfile('/uploaded/'.$crsdata{'domain'}.'/'.
   75: 				      $crsdata{'num'}.'/'.$which);
   76:     return $file;
   77: }
   78: 
   79: # ============================================================ Write a userfile
   80: 
   81: sub writefile {
   82:     (my $courseid, my $which,$env{'form.output'})=@_;
   83:     my %crsdata=&Apache::lonnet::coursedescription($courseid);
   84:     my $data = &Apache::lonnet::finishuserfileupload(
   85: 					  $crsdata{'num'},$crsdata{'domain'},
   86: 					  'output',$which);
   87:     return $data;
   88: }
   89: 
   90: # ===================================================================== Rewrite
   91: 
   92: sub rewritefile {
   93:     my ($contents,%rewritehash)=@_;
   94:     foreach my $pattern (keys(%rewritehash)) {
   95: 	my $new=$rewritehash{$pattern};
   96: 	$contents=~s/\Q$pattern\E/$new/gs;
   97:     }
   98:     return $contents;
   99: }
  100: 
  101: # ============================================================= Copy a userfile
  102: 
  103: sub copyfile {
  104:     my ($origcrsid,$newcrsid,$which)=@_;
  105:     unless ($which=~/\.sequence$/) {
  106: 	return &writefile($newcrsid,$which,
  107: 		      &readfile($origcrsid,$which));
  108:     } else {
  109: 	my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
  110: 	my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
  111: 	return &writefile($newcrsid,$which,
  112: 		 &rewritefile(
  113:                      &readfile($origcrsid,$which),
  114: 	    (
  115:        '/uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
  116:     => '/uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/',
  117:        '/public/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
  118:     => '/public/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/',
  119:        '/adm/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
  120:     => '/adm/'.$newcrsdata{'domain'}.'/'.$newcrsdata{'num'}.'/',
  121:             )));
  122:     }
  123: }
  124: 
  125: # =============================================================== Copy a dbfile
  126: 
  127: sub copydb {
  128:     my ($origcrsid,$newcrsid,$which)=@_;
  129:     $which=~s/\.db$//;
  130:     my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
  131:     my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
  132:     my %data=&Apache::lonnet::dump
  133: 	($which,$origcrsdata{'domain'},$origcrsdata{'num'});
  134:     foreach my $key (keys(%data)) {
  135: 	if ($key=~/^internal./) { delete($data{$key}); }
  136:     }
  137:     return &Apache::lonnet::put
  138: 	($which,\%data,$newcrsdata{'domain'},$newcrsdata{'num'});
  139: }
  140: 
  141: # ========================================================== Copy resourcesdata
  142: 
  143: sub copyresourcedb {
  144:     my ($origcrsid,$newcrsid)=@_;
  145:     my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
  146:     my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
  147:     my %data=&Apache::lonnet::dump
  148: 	('resourcedata',$origcrsdata{'domain'},$origcrsdata{'num'});
  149:     $origcrsid=~s/^\///;
  150:     $origcrsid=~s/\//\_/;
  151:     $newcrsid=~s/^\///;
  152:     $newcrsid=~s/\//\_/;
  153:     my %newdata=();
  154:     undef %newdata;
  155:     my $startdate=$data{$origcrsid.'.0.opendate'};
  156:     if (!$startdate) {
  157: 	# now global start date for assements try the enrollment start
  158: 	my %start=&Apache::lonnet::get('environment',
  159: 				   ['default_enrollment_start_date'],
  160: 				   $origcrsdata{'domain'},$origcrsdata{'num'});
  161: 
  162: 	$startdate = $start{'default_enrollment_start_date'};
  163:     }
  164:     my $today=time;
  165:     my $delta=0;
  166:     if ($startdate) {
  167: 	my $oneday=60*60*24;
  168: 	$delta=$today-$startdate;
  169: 	$delta=int($delta/$oneday)*$oneday;
  170:     }
  171: # ugly retro fix for broken version of types
  172:     foreach (keys %data) {
  173: 	if ($_=~/\wtype$/) {
  174: 	    my $newkey=$_;
  175: 	    $newkey=~s/type$/\.type/;
  176: 	    $data{$newkey}=$data{$_};
  177: 	    delete $data{$_};
  178: 	}
  179:     }
  180: # adjust symbs
  181:     my $pattern='uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/';
  182:     my $new=    'uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/';
  183:     foreach (keys %data) {
  184: 	if ($_=~/\Q$pattern\E/) {
  185: 	    my $newkey=$_;
  186: 	    $newkey=~s/\Q$pattern\E/$new/;
  187: 	    $data{$newkey}=$data{$_};
  188: 	    delete $data{$_};
  189: 	}
  190:     }
  191: # adjust dates
  192:     foreach (keys %data) {
  193: 	my $thiskey=$_;
  194: 	$thiskey=~s/^$origcrsid/$newcrsid/;
  195: 	$newdata{$thiskey}=$data{$_};
  196: 	if ($data{$_.'.type'}=~/^date_(start|end)$/) {
  197: 	    if ($delta > 0) {
  198: 		$newdata{$thiskey}=$newdata{$thiskey}+$delta;
  199: 	    } else {
  200: 		# no delta, it's unlikely we want the old dates and times
  201: 		delete($newdata{$thiskey});
  202: 		delete($newdata{$thiskey.'.type'});
  203: 	    }
  204: 	}
  205:     }
  206:     return &Apache::lonnet::put
  207: 	('resourcedata',\%newdata,$newcrsdata{'domain'},$newcrsdata{'num'});
  208: }
  209: 
  210: # ========================================================== Copy all userfiles
  211: 
  212: sub copyuserfiles {
  213:     my ($origcrsid,$newcrsid)=@_;
  214:     foreach (&crsdirlist($origcrsid,'userfiles')) {
  215: 	if ($_ !~m|^scantron_|) {
  216: 	    &copyfile($origcrsid,$newcrsid,$_);
  217: 	}
  218:     }
  219: }
  220: # ========================================================== Copy all userfiles
  221: 
  222: sub copydbfiles {
  223:     my ($origcrsid,$newcrsid)=@_;
  224: 
  225:     my ($origcrs_discussion) = ($origcrsid=~m|^/(.*)|);
  226:     $origcrs_discussion=~s|/|_|g;
  227:     foreach (&crsdirlist($origcrsid)) {
  228: 	if ($_=~/\.db$/) {
  229: 	    unless 
  230:              ($_=~/^(nohist\_|discussiontimes|classlist|versionupdate|resourcedata|\Q$origcrs_discussion\E|slots|slot_reservations|gradingqueue|reviewqueue|CODEs|groupmembership)/) {
  231: 		 &copydb($origcrsid,$newcrsid,$_);
  232: 	     }
  233: 	}
  234:     }
  235: }
  236: 
  237: # ======================================================= Copy all course files
  238: 
  239: sub copycoursefiles {
  240:     my ($origcrsid,$newcrsid)=@_;
  241:     &copyuserfiles($origcrsid,$newcrsid);
  242:     &copydbfiles($origcrsid,$newcrsid);
  243:     &copyresourcedb($origcrsid,$newcrsid);
  244: }
  245: 
  246: 1;