Return to lonclonecourse.pm CVS log

Up to [LON-CAPA] / loncom / interface

- When cloning a course containing external tool(s) update course label and
  course title in all instances of tool(s), if values for them in cloned course
  contained default values: institutional code and course description.

    1: # The LearningOnline Network
    2: # routines for clone a course
    3: #
    4: # $Id: lonclonecourse.pm,v 1.14 2020/06/01 20:35:02 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: use DateTime();
   34: use DateTime::TimeZone;
   35: 
   36: # ================================================ Get course directory listing
   37: 
   38: my @output=();
   39: 
   40: sub crsdirlist {
   41:     my ($courseid,$which)=@_;
   42:     @output=();
   43:     return &innercrsdirlist($courseid,$which);
   44: }
   45: 
   46: sub innercrsdirlist {
   47:     my ($courseid,$which,$path)=@_;
   48:     my $dirptr=16384;
   49:     unless ($which) { $which=''; } else { $which.='/'; }
   50:     unless ($path)  { $path=''; } else { $path.='/'; }
   51:     my %crsdata=&Apache::lonnet::coursedescription($courseid);
   52:     my $getpropath = 1;
   53:     my ($dirlistref,$listerror) = 
   54:         &Apache::lonnet::dirlist($which,$crsdata{'domain'},
   55:                                  $crsdata{'num'},$getpropath);
   56:     if (ref($dirlistref) eq 'ARRAY') {
   57:         foreach (@{$dirlistref}) {
   58: 	    unless ($_=~/^\./) {
   59: 	        my @unpackline = split (/\&/,$_);
   60: 	        if ($unpackline[3]&$dirptr) {
   61: # is a directory, recurse
   62: 		    &innercrsdirlist($courseid,$which.$unpackline[0],
   63: 				     $path.$unpackline[0]);
   64: 	        } else { 
   65: # is a file, put into output
   66: 		    push (@output,$path.$unpackline[0]);
   67: 	        }
   68: 	    }
   69:         }
   70:     }
   71:     return @output;
   72: }
   73: 
   74: # ============================================================= Read a userfile
   75: 
   76: sub readfile {
   77:     my ($courseid,$which)=@_;
   78:     my %crsdata=&Apache::lonnet::coursedescription($courseid);
   79:     my $file = &Apache::lonnet::getfile('/uploaded/'.$crsdata{'domain'}.'/'.
   80: 				      $crsdata{'num'}.'/'.$which);
   81:     return $file;
   82: }
   83: 
   84: # ============================================================ Write a userfile
   85: 
   86: sub writefile {
   87:     (my $courseid, my $which,$env{'form.output'})=@_;
   88:     my %crsdata=&Apache::lonnet::coursedescription($courseid);
   89:     my $data = &Apache::lonnet::finishuserfileupload(
   90: 					  $crsdata{'num'},$crsdata{'domain'},
   91: 					  'output',$which);
   92:     return $data;
   93: }
   94: 
   95: # ===================================================================== Rewrite
   96: 
   97: sub rewritefile {
   98:     my ($contents,%rewritehash)=@_;
   99:     foreach my $pattern (keys(%rewritehash)) {
  100: 	my $new=$rewritehash{$pattern};
  101: 	$contents=~s/\Q$pattern\E/$new/gs;
  102:     }
  103:     return $contents;
  104: }
  105: 
  106: # ============================================================= Copy a userfile
  107: 
  108: sub copyfile {
  109:     my ($origcrsid,$newcrsid,$which)=@_;
  110:     unless ($which=~/\.sequence$/) {
  111: 	return &writefile($newcrsid,$which,
  112: 		      &readfile($origcrsid,$which));
  113:     } else {
  114: 	my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
  115: 	my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
  116: 	return &writefile($newcrsid,$which,
  117: 		 &rewritefile(
  118:                      &readfile($origcrsid,$which),
  119: 	    (
  120:        '/uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
  121:     => '/uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/',
  122:        '/public/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
  123:     => '/public/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/',
  124:        '/adm/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
  125:     => '/adm/'.$newcrsdata{'domain'}.'/'.$newcrsdata{'num'}.'/',
  126:             )));
  127:     }
  128: }
  129: 
  130: # =============================================================== Copy a dbfile
  131: 
  132: sub copydb {
  133:     my ($origcrsid,$newcrsid,$which,$newinstcode)=@_;
  134:     $which=~s/\.db$//;
  135:     my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
  136:     my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
  137:     my %data=&Apache::lonnet::dump
  138: 	($which,$origcrsdata{'domain'},$origcrsdata{'num'});
  139:     foreach my $key (keys(%data)) {
  140: 	if ($key=~/^internal./) { delete($data{$key}); }
  141:     }
  142:     if ($which =~ /^exttool_\d+$/) {
  143:         if ($origcrsdata{'description'} ne $newcrsdata{'description'}) {
  144:             $data{'crstitle'} =~s/\Q$origcrsdata{'description'}\E/$newcrsdata{'description'}/;
  145:         }
  146:         if ($origcrsdata{'internal.coursecode'} ne $newinstcode) {
  147:             $data{'crslabel'} =~ s/\Q$origcrsdata{'internal.coursecode'}\E/$newinstcode/;
  148:         }
  149:     }
  150:     return &Apache::lonnet::put
  151: 	($which,\%data,$newcrsdata{'domain'},$newcrsdata{'num'});
  152: }
  153: 
  154: # ========================================================== Copy resourcesdata
  155: 
  156: sub copyresourcedb {
  157:     my ($origcrsid,$newcrsid,$date_mode,$date_shift)=@_;
  158:     my $delta=$date_shift*60*60*24;
  159:     my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
  160:     my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
  161:     my $origtz;
  162:     if (($date_mode) && ($date_mode ne 'preserve') && ($date_shift) && 
  163:         (int($date_shift) == $date_shift)) {
  164:         $origtz = $origcrsdata{'timezone'};
  165:         if ($origtz eq '') {
  166:             my %domdefaults = &Apache::lonnet::get_domain_defaults($origcrsdata{'domain'});
  167:             if ($domdefaults{'timezone_def'} ne '') {
  168:                 $origtz = $domdefaults{'timezone_def'};
  169:             }
  170:         }
  171:         if ($origtz eq '') {
  172:             $origtz = 'local';
  173:         } elsif (!DateTime::TimeZone->is_valid_name($origtz)) {
  174:             $origtz = 'local';
  175:         }
  176:     }
  177:     my %data=&Apache::lonnet::dump
  178: 	('resourcedata',$origcrsdata{'domain'},$origcrsdata{'num'});
  179:     $origcrsid=~s/^\///;
  180:     $origcrsid=~s/\//\_/;
  181:     $newcrsid=~s/^\///;
  182:     $newcrsid=~s/\//\_/;
  183:     my %newdata=();
  184:     undef %newdata;
  185:     my $startdate=$data{$origcrsid.'.0.opendate'};
  186:     if (!$startdate) {
  187: 	# now global start date for assements try the enrollment start
  188: 	my %start=&Apache::lonnet::get('environment',
  189: 				   ['default_enrollment_start_date'],
  190: 				   $origcrsdata{'domain'},$origcrsdata{'num'});
  191: 
  192: 	$startdate = $start{'default_enrollment_start_date'};
  193:     }
  194: # ugly retro fix for broken version of types
  195:     foreach my $key (keys(%data)) {
  196: 	if ($key=~/\wtype$/) {
  197: 	    my $newkey=$key;
  198: 	    $newkey=~s/type$/\.type/;
  199: 	    $data{$newkey}=$data{$key};
  200: 	    delete $data{$key};
  201: 	}
  202:     }
  203: # adjust symbs
  204:     my $pattern='uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/';
  205:     my $new=    'uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/';
  206:     foreach my $key (keys(%data)) {
  207: 	if ($key=~/\Q$pattern\E/) {
  208: 	    my $newkey=$key;
  209: 	    $newkey=~s/\Q$pattern\E/$new/;
  210: 	    $data{$newkey}=$data{$key};
  211: 	    delete $data{$key};
  212: 	}
  213:     }
  214: #  transfer hash
  215:     foreach my $key (keys(%data)) {
  216: 	my $thiskey=$key;
  217: 	$thiskey=~s/^$origcrsid/$newcrsid/;
  218: 	$newdata{$thiskey}=$data{$key};
  219: # date_mode empty or "preserve": transfer dates one-to-one
  220: # date_mode "shift": shift dates by date_shift days
  221: # date_mode other: do not transfer dates
  222:         if (($date_mode) && ($date_mode ne 'preserve')) {
  223: 	    if ($data{$key.'.type'}=~/^date_(start|end)$/) {
  224: 	        if ($date_mode eq 'shift') {
  225:                     if (($date_shift) && ($date_shift == int($date_shift))) { 
  226:                         my $dt = DateTime->from_epoch(epoch => $newdata{$thiskey})
  227:                                                       ->set_time_zone($origtz);
  228:                         if (($origtz eq 'local') && (!$ENV{TZ})) {
  229:                             $ENV{TZ} = $dt->time_zone()->name();
  230:                         }
  231:                         eval {
  232:                             $dt->add(days => int($date_shift));
  233:                         };
  234:                         if ($@) {
  235:                             $newdata{$thiskey} = $newdata{$thiskey}+$delta+(60*60);
  236:                         } else {
  237:                             $newdata{$thiskey} = $dt->epoch();
  238:                         }
  239:                     } else {
  240:                         $newdata{$thiskey} = $newdata{$thiskey}+$delta;
  241:                     }
  242:                 } else {
  243:                     delete($newdata{$thiskey});
  244:                     delete($newdata{$thiskey.'.type'});
  245:                 }
  246:             }
  247:         }
  248:     }
  249:     return &Apache::lonnet::put
  250: 	('resourcedata',\%newdata,$newcrsdata{'domain'},$newcrsdata{'num'});
  251: }
  252: 
  253: # ========================================================== Copy all userfiles
  254: 
  255: sub copyuserfiles {
  256:     my ($origcrsid,$newcrsid)=@_;
  257:     foreach (&crsdirlist($origcrsid,'userfiles')) {
  258: 	if ($_ !~m|^scantron_|) {
  259: 	    &copyfile($origcrsid,$newcrsid,$_);
  260: 	}
  261:     }
  262: }
  263: # ========================================================== Copy all userfiles
  264: 
  265: sub copydbfiles {
  266:     my ($origcrsid,$newcrsid,$newinstcode)=@_;
  267: 
  268:     my ($origcrs_discussion) = ($origcrsid=~m|^/(.*)|);
  269:     $origcrs_discussion=~s|/|_|g;
  270:     foreach (&crsdirlist($origcrsid)) {
  271: 	if ($_=~/\.db$/) {
  272:         unless ($_=~/^(nohist\_|disclikes|discussiontimes|classlist|versionupdate
  273:                 |resourcedata|\Q$origcrs_discussion\E|slots|slot_reservations
  274:                 |gradingqueue|reviewqueue|CODEs|groupmembership|comm_block)/) {
  275:             &copydb($origcrsid,$newcrsid,$_,$newinstcode);
  276:         }
  277: 	}
  278:     }
  279: }
  280: 
  281: # ======================================================= Copy all course files
  282: 
  283: sub copycoursefiles {
  284:     my ($origcrsid,$newcrsid,$date_mode,$date_shift,$newinstcode)=@_;
  285:     &copyuserfiles($origcrsid,$newcrsid);
  286:     &copydbfiles($origcrsid,$newcrsid,$newinstcode);
  287:     &copyresourcedb($origcrsid,$newcrsid,$date_mode,$date_shift);
  288: }
  289: 
  290: 1;