--- loncom/interface/lonclonecourse.pm 2010/03/01 20:11:03 1.7.12.2 +++ loncom/interface/lonclonecourse.pm 2016/01/21 00:12:38 1.12 @@ -1,7 +1,7 @@ # The LearningOnline Network # routines for clone a course # -# $Id: lonclonecourse.pm,v 1.7.12.2 2010/03/01 20:11:03 raeburn Exp $ +# $Id: lonclonecourse.pm,v 1.12 2016/01/21 00:12:38 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -30,7 +30,8 @@ package Apache::lonclonecourse; use LONCAPA; use Apache::lonnet; -use Apache::loncoursedata; +use DateTime(); +use DateTime::TimeZone; # ================================================ Get course directory listing @@ -49,20 +50,23 @@ sub innercrsdirlist { unless ($path) { $path=''; } else { $path.='/'; } my %crsdata=&Apache::lonnet::coursedescription($courseid); my $getpropath = 1; - my @listing=&Apache::lonnet::dirlist - ($which,$crsdata{'domain'},$crsdata{'num'},$getpropath); - foreach (@listing) { - unless ($_=~/^\./) { - my @unpackline = split (/\&/,$_); - if ($unpackline[3]&$dirptr) { + my ($dirlistref,$listerror) = + &Apache::lonnet::dirlist($which,$crsdata{'domain'}, + $crsdata{'num'},$getpropath); + if (ref($dirlistref) eq 'ARRAY') { + foreach (@{$dirlistref}) { + unless ($_=~/^\./) { + my @unpackline = split (/\&/,$_); + if ($unpackline[3]&$dirptr) { # is a directory, recurse - &innercrsdirlist($courseid,$which.$unpackline[0], - $path.$unpackline[0]); - } else { + &innercrsdirlist($courseid,$which.$unpackline[0], + $path.$unpackline[0]); + } else { # is a file, put into output - push (@output,$path.$unpackline[0]); + push (@output,$path.$unpackline[0]); + } } - } + } } return @output; } @@ -146,6 +150,22 @@ sub copyresourcedb { my $delta=$date_shift*60*60*24; my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid); my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid); + my $origtz; + if (($date_mode) && ($date_mode ne 'preserve') && ($date_shift) && + (int($date_shift) == $date_shift)) { + $origtz = $origcrsdata{'timezone'}; + if ($origtz eq '') { + my %domdefaults = &Apache::lonnet::get_domain_defaults($origcrsdata{'domain'}); + if ($domdefaults{'timezone_def'} ne '') { + $origtz = $domdefaults{'timezone_def'}; + } + } + if ($origtz eq '') { + $origtz = 'local'; + } elsif (!DateTime::TimeZone->is_valid_name($origtz)) { + $origtz = 'local'; + } + } my %data=&Apache::lonnet::dump ('resourcedata',$origcrsdata{'domain'},$origcrsdata{'num'}); $origcrsid=~s/^\///; @@ -164,7 +184,7 @@ sub copyresourcedb { $startdate = $start{'default_enrollment_start_date'}; } # ugly retro fix for broken version of types - foreach my $key (keys %data) { + foreach my $key (keys(%data)) { if ($key=~/\wtype$/) { my $newkey=$key; $newkey=~s/type$/\.type/; @@ -175,7 +195,7 @@ sub copyresourcedb { # adjust symbs my $pattern='uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'; my $new= 'uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/'; - foreach my $key (keys %data) { + foreach my $key (keys(%data)) { if ($key=~/\Q$pattern\E/) { my $newkey=$key; $newkey=~s/\Q$pattern\E/$new/; @@ -184,7 +204,7 @@ sub copyresourcedb { } } # transfer hash - foreach my $key (keys %data) { + foreach my $key (keys(%data)) { my $thiskey=$key; $thiskey=~s/^$origcrsid/$newcrsid/; $newdata{$thiskey}=$data{$key}; @@ -193,14 +213,24 @@ sub copyresourcedb { # date_mode other: do not transfer dates if (($date_mode) && ($date_mode ne 'preserve')) { if ($data{$key.'.type'}=~/^date_(start|end)$/) { - if ($date_mode eq 'shift') { - $newdata{$thiskey}=$newdata{$thiskey}+$delta; - } else { - delete($newdata{$thiskey}); - delete($newdata{$thiskey.'.type'}); - } + if ($date_mode eq 'shift') { + if (($date_shift) && ($date_shift == int($date_shift))) { + my $dt = DateTime->from_epoch(epoch => $newdata{$thiskey}) + ->set_time_zone($origtz); + if (($origtz eq 'local') && (!$ENV{TZ})) { + $ENV{TZ} = $dt->time_zone()->name(); + } + $dt->add(days => int($date_shift)); + $newdata{$thiskey} = $dt->epoch(); + } else { + $newdata{$thiskey} = $newdata{$thiskey}+$delta; + } + } else { + delete($newdata{$thiskey}); + delete($newdata{$thiskey.'.type'}); + } } - } + } } return &Apache::lonnet::put ('resourcedata',\%newdata,$newcrsdata{'domain'},$newcrsdata{'num'}); @@ -225,10 +255,11 @@ sub copydbfiles { $origcrs_discussion=~s|/|_|g; foreach (&crsdirlist($origcrsid)) { if ($_=~/\.db$/) { - unless - ($_=~/^(nohist\_|discussiontimes|classlist|versionupdate|resourcedata|\Q$origcrs_discussion\E|slots|slot_reservations|gradingqueue|reviewqueue|CODEs|groupmembership)/) { - ©db($origcrsid,$newcrsid,$_); - } + unless ($_=~/^(nohist\_|disclikes|discussiontimes|classlist|versionupdate + |resourcedata|\Q$origcrs_discussion\E|slots|slot_reservations + |gradingqueue|reviewqueue|CODEs|groupmembership|comm_block)/) { + ©db($origcrsid,$newcrsid,$_); + } } } } @@ -242,74 +273,4 @@ sub copycoursefiles { ©resourcedb($origcrsid,$newcrsid,$date_mode,$date_shift); } -sub copyroster { - my ($origcrsid,$newcrsid,$accessstart,$accessend) = @_; - my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid); - my %newcrsdata=&Apache::lonnet::coursedescription($newcrsid); - my $classlist = - &Apache::loncoursedata::get_classlist($origcrsdata{'domain'},$origcrsdata{'num'}); - my %origdate = &Apache::lonnet::get('environment', - ['default_enrollment_end_date'], - $origcrsdata{'domain'},$origcrsdata{'num'}); - - my $enddate = $origdate{'default_enrollment_end_date'}; - - my $end_idx = &Apache::loncoursedata::CL_END(); - my $start_idx = &Apache::loncoursedata::CL_START(); - my $id_idx = &Apache::loncoursedata::CL_ID(); - my $sec_idx = &Apache::loncoursedata::CL_SECTION(); - my $name_idx = &Apache::loncoursedata::CL_FULLNAME(); - my $status_idx = &Apache::loncoursedata::CL_STATUS(); - my $type_idx = &Apache::loncoursedata::CL_TYPE(); - my $locktype_idx = &Apache::loncoursedata::CL_LOCKEDTYPE(); - - my (%newstudents,%rolesadded,$numadded); - my $numadded = 0; - if (ref($classlist) eq 'HASH') { - foreach my $student (sort(keys(%{$classlist}))) { - my ($sname,$sdom) = split(/:/,$student); - next if ($classlist->{$student}->[$end_idx] eq '-1' - || ($classlist->{$student}->[$start_idx] eq '-1')); - if (($classlist->{$student}->[$status_idx] eq 'Active') || - ($classlist->{$student}->[$end_idx] >= $enddate)) { - if (ref($classlist->{$student}) eq 'ARRAY') { - my $sec = $classlist->{$student}->[$sec_idx]; - $newstudents{$student}{'section'} = $sec; - $newstudents{$student}{'info'} = - $accessend.':'. - $accessstart.':'. - $classlist->{$student}->[$id_idx].':'. - $sec.':'. - $classlist->{$student}->[$name_idx].':'. - $classlist->{$student}->[$type_idx].':'. - $classlist->{$student}->[$locktype_idx]; - } - } - } - } - if (keys(%newstudents)) { - my $uurl=$newcrsid; - $uurl=~s/\_/\//g; - foreach my $student (sort(keys(%newstudents))) { - my $surl = $uurl; - if ($newstudents{$student}{'section'}) { - $surl.='/'.$newstudents{$student}{'section'}; - } - my ($sname,$sdom) = split(/:/,$student); - if (&Apache::lonnet::assignrole($sdom,$sname,$uurl,'st',$accessend,$accessstart,undef,undef,'requestcourses') eq 'ok') { - $rolesadded{$student} = $newstudents{$student}{'info'}; - $numadded ++ ; - } - } - } - my $clisterror; - if (keys(%rolesadded) > 0) { - my $reply = &Apache::lonnet::cput('classlist',\%rolesadded,$newcrsdata{'domain'},$newcrsdata{'num'}); - unless (($reply eq 'ok') || ($reply eq 'delayed')) { - $clisterror = 'error: '.$reply; - } - } - return ($numadded,$clisterror); -} - 1;