Return to lonclonecourse.pm CVS log

Up to [LON-CAPA] / loncom / interface

- Customization for GCI_3
  - Some corrections to changes in 1.7.12.1
    - Include package in calls to cput() and assignrole().
    - Eliminate surplus call to get_classlist()
    - Correct $uurl passed to assignrole()
    - items in array ref from $classlist->{$student} different from
      items to be passed in hash ref to cput for update of classlist db.

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