--- loncom/interface/lonclonecourse.pm 2008/01/22 22:37:18 1.6 +++ 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.6 2008/01/22 22:37:18 www Exp $ +# $Id: lonclonecourse.pm,v 1.12 2016/01/21 00:12:38 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -30,6 +30,8 @@ package Apache::lonclonecourse; use LONCAPA; use Apache::lonnet; +use DateTime(); +use DateTime::TimeZone; # ================================================ Get course directory listing @@ -47,21 +49,24 @@ sub innercrsdirlist { unless ($which) { $which=''; } else { $which.='/'; } unless ($path) { $path=''; } else { $path.='/'; } my %crsdata=&Apache::lonnet::coursedescription($courseid); - my @listing=&Apache::lonnet::dirlist - ($which,$crsdata{'domain'},$crsdata{'num'}, - &propath($crsdata{'domain'},$crsdata{'num'})); - foreach (@listing) { - unless ($_=~/^\./) { - my @unpackline = split (/\&/,$_); - if ($unpackline[3]&$dirptr) { + my $getpropath = 1; + 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; } @@ -145,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/^\///; @@ -163,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/; @@ -174,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/; @@ -183,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}; @@ -192,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'}); @@ -224,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,$_); + } } } }