Annotation of loncom/interface/lonclonecourse.pm, revision 1.6

1.1       albertel    1: # The LearningOnline Network
                      2: # routines for clone a course
                      3: #
1.6     ! www         4: # $Id: lonclonecourse.pm,v 1.5 2008/01/21 17:47:21 www Exp $
1.1       albertel    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)=@_;
1.2       albertel   94:     foreach my $pattern (keys(%rewritehash)) {
                     95: 	my $new=$rewritehash{$pattern};
                     96: 	$contents=~s/\Q$pattern\E/$new/gs;
1.1       albertel   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'}.'/'
1.4       raeburn   118:     => '/public/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/',
                    119:        '/adm/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
                    120:     => '/adm/'.$newcrsdata{'domain'}.'/'.$newcrsdata{'num'}.'/',
1.1       albertel  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 {
1.6     ! www       144:     my ($origcrsid,$newcrsid,$date_mode,$date_shift)=@_;
        !           145:     my $delta=$date_shift*60*60*24;
1.1       albertel  146:     my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
                    147:     my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
                    148:     my %data=&Apache::lonnet::dump
                    149: 	('resourcedata',$origcrsdata{'domain'},$origcrsdata{'num'});
                    150:     $origcrsid=~s/^\///;
                    151:     $origcrsid=~s/\//\_/;
                    152:     $newcrsid=~s/^\///;
                    153:     $newcrsid=~s/\//\_/;
                    154:     my %newdata=();
                    155:     undef %newdata;
                    156:     my $startdate=$data{$origcrsid.'.0.opendate'};
                    157:     if (!$startdate) {
                    158: 	# now global start date for assements try the enrollment start
                    159: 	my %start=&Apache::lonnet::get('environment',
                    160: 				   ['default_enrollment_start_date'],
                    161: 				   $origcrsdata{'domain'},$origcrsdata{'num'});
                    162: 
                    163: 	$startdate = $start{'default_enrollment_start_date'};
                    164:     }
                    165: # ugly retro fix for broken version of types
1.6     ! www       166:     foreach my $key (keys %data) {
        !           167: 	if ($key=~/\wtype$/) {
        !           168: 	    my $newkey=$key;
1.1       albertel  169: 	    $newkey=~s/type$/\.type/;
1.6     ! www       170: 	    $data{$newkey}=$data{$key};
        !           171: 	    delete $data{$key};
1.1       albertel  172: 	}
                    173:     }
                    174: # adjust symbs
                    175:     my $pattern='uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/';
                    176:     my $new=    'uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/';
1.6     ! www       177:     foreach my $key (keys %data) {
        !           178: 	if ($key=~/\Q$pattern\E/) {
        !           179: 	    my $newkey=$key;
1.2       albertel  180: 	    $newkey=~s/\Q$pattern\E/$new/;
1.6     ! www       181: 	    $data{$newkey}=$data{$key};
        !           182: 	    delete $data{$key};
        !           183: 	}
        !           184:     }
        !           185: #  transfer hash
        !           186:     foreach my $key (keys %data) {
        !           187: 	my $thiskey=$key;
        !           188: 	$thiskey=~s/^$origcrsid/$newcrsid/;
        !           189: 	$newdata{$thiskey}=$data{$key};
        !           190: # date_mode empty or "preserve": transfer dates one-to-one
        !           191: # date_mode "shift": shift dates by date_shift days
        !           192: # date_mode other: do not transfer dates
        !           193:         if (($date_mode) && ($date_mode ne 'preserve')) {
        !           194: 	    if ($data{$key.'.type'}=~/^date_(start|end)$/) {
        !           195: 	       if ($date_mode eq 'shift') {
        !           196: 		  $newdata{$thiskey}=$newdata{$thiskey}+$delta;
        !           197: 	       } else {
        !           198: 		  delete($newdata{$thiskey});
        !           199: 		  delete($newdata{$thiskey.'.type'});
        !           200: 	       }
        !           201:             }
1.1       albertel  202: 	}
                    203:     }
                    204:     return &Apache::lonnet::put
                    205: 	('resourcedata',\%newdata,$newcrsdata{'domain'},$newcrsdata{'num'});
                    206: }
                    207: 
                    208: # ========================================================== Copy all userfiles
                    209: 
                    210: sub copyuserfiles {
                    211:     my ($origcrsid,$newcrsid)=@_;
                    212:     foreach (&crsdirlist($origcrsid,'userfiles')) {
                    213: 	if ($_ !~m|^scantron_|) {
                    214: 	    &copyfile($origcrsid,$newcrsid,$_);
                    215: 	}
                    216:     }
                    217: }
                    218: # ========================================================== Copy all userfiles
                    219: 
                    220: sub copydbfiles {
                    221:     my ($origcrsid,$newcrsid)=@_;
                    222: 
                    223:     my ($origcrs_discussion) = ($origcrsid=~m|^/(.*)|);
                    224:     $origcrs_discussion=~s|/|_|g;
                    225:     foreach (&crsdirlist($origcrsid)) {
                    226: 	if ($_=~/\.db$/) {
                    227: 	    unless 
                    228:              ($_=~/^(nohist\_|discussiontimes|classlist|versionupdate|resourcedata|\Q$origcrs_discussion\E|slots|slot_reservations|gradingqueue|reviewqueue|CODEs|groupmembership)/) {
                    229: 		 &copydb($origcrsid,$newcrsid,$_);
                    230: 	     }
                    231: 	}
                    232:     }
                    233: }
                    234: 
                    235: # ======================================================= Copy all course files
                    236: 
                    237: sub copycoursefiles {
1.6     ! www       238:     my ($origcrsid,$newcrsid,$date_mode,$date_shift)=@_;
1.1       albertel  239:     &copyuserfiles($origcrsid,$newcrsid);
                    240:     &copydbfiles($origcrsid,$newcrsid);
1.6     ! www       241:     &copyresourcedb($origcrsid,$newcrsid,$date_mode,$date_shift);
1.1       albertel  242: }
                    243: 
                    244: 1;

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