[BACK]Return to lonclonecourse.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonclonecourse.pm between versions 1.7.12.1 and 1.14

version 1.7.12.1, 2010/02/26 22:45:03 version 1.14, 2020/06/01 20:35:02
Line 30 Line 30
 package Apache::lonclonecourse;  package Apache::lonclonecourse;
 use LONCAPA;  use LONCAPA;
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::loncoursedata;  use DateTime();
   use DateTime::TimeZone;
   
 # ================================================ Get course directory listing  # ================================================ Get course directory listing
   
Line 49  sub innercrsdirlist { Line 50  sub innercrsdirlist {
     unless ($path)  { $path=''; } else { $path.='/'; }      unless ($path)  { $path=''; } else { $path.='/'; }
     my %crsdata=&Apache::lonnet::coursedescription($courseid);      my %crsdata=&Apache::lonnet::coursedescription($courseid);
     my $getpropath = 1;      my $getpropath = 1;
     my @listing=&Apache::lonnet::dirlist      my ($dirlistref,$listerror) = 
  ($which,$crsdata{'domain'},$crsdata{'num'},$getpropath);          &Apache::lonnet::dirlist($which,$crsdata{'domain'},
     foreach (@listing) {                                   $crsdata{'num'},$getpropath);
  unless ($_=~/^\./) {      if (ref($dirlistref) eq 'ARRAY') {
     my @unpackline = split (/\&/,$_);          foreach (@{$dirlistref}) {
     if ($unpackline[3]&$dirptr) {      unless ($_=~/^\./) {
           my @unpackline = split (/\&/,$_);
           if ($unpackline[3]&$dirptr) {
 # is a directory, recurse  # is a directory, recurse
  &innercrsdirlist($courseid,$which.$unpackline[0],      &innercrsdirlist($courseid,$which.$unpackline[0],
             $path.$unpackline[0]);       $path.$unpackline[0]);
     } else {           } else { 
 # is a file, put into output  # is a file, put into output
  push (@output,$path.$unpackline[0]);      push (@output,$path.$unpackline[0]);
           }
     }      }
  }          }
     }      }
     return @output;      return @output;
 }  }
Line 126  sub copyfile { Line 130  sub copyfile {
 # =============================================================== Copy a dbfile  # =============================================================== Copy a dbfile
   
 sub copydb {  sub copydb {
     my ($origcrsid,$newcrsid,$which)=@_;      my ($origcrsid,$newcrsid,$which,$newinstcode)=@_;
     $which=~s/\.db$//;      $which=~s/\.db$//;
     my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);      my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
     my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);      my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
Line 135  sub copydb { Line 139  sub copydb {
     foreach my $key (keys(%data)) {      foreach my $key (keys(%data)) {
  if ($key=~/^internal./) { delete($data{$key}); }   if ($key=~/^internal./) { delete($data{$key}); }
     }      }
       if ($which =~ /^exttool_\d+$/) {
           if ($origcrsdata{'description'} ne $newcrsdata{'description'}) {
               $data{'crstitle'} =~s/\Q$origcrsdata{'description'}\E/$newcrsdata{'description'}/;
           }
           if ($origcrsdata{'internal.coursecode'} ne $newinstcode) {
               $data{'crslabel'} =~ s/\Q$origcrsdata{'internal.coursecode'}\E/$newinstcode/;
           }
       }
     return &Apache::lonnet::put      return &Apache::lonnet::put
  ($which,\%data,$newcrsdata{'domain'},$newcrsdata{'num'});   ($which,\%data,$newcrsdata{'domain'},$newcrsdata{'num'});
 }  }
Line 146  sub copyresourcedb { Line 158  sub copyresourcedb {
     my $delta=$date_shift*60*60*24;      my $delta=$date_shift*60*60*24;
     my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);      my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
     my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);      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      my %data=&Apache::lonnet::dump
  ('resourcedata',$origcrsdata{'domain'},$origcrsdata{'num'});   ('resourcedata',$origcrsdata{'domain'},$origcrsdata{'num'});
     $origcrsid=~s/^\///;      $origcrsid=~s/^\///;
Line 164  sub copyresourcedb { Line 192  sub copyresourcedb {
  $startdate = $start{'default_enrollment_start_date'};   $startdate = $start{'default_enrollment_start_date'};
     }      }
 # ugly retro fix for broken version of types  # ugly retro fix for broken version of types
     foreach my $key (keys %data) {      foreach my $key (keys(%data)) {
  if ($key=~/\wtype$/) {   if ($key=~/\wtype$/) {
     my $newkey=$key;      my $newkey=$key;
     $newkey=~s/type$/\.type/;      $newkey=~s/type$/\.type/;
Line 175  sub copyresourcedb { Line 203  sub copyresourcedb {
 # adjust symbs  # adjust symbs
     my $pattern='uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/';      my $pattern='uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/';
     my $new=    'uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/';      my $new=    'uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/';
     foreach my $key (keys %data) {      foreach my $key (keys(%data)) {
  if ($key=~/\Q$pattern\E/) {   if ($key=~/\Q$pattern\E/) {
     my $newkey=$key;      my $newkey=$key;
     $newkey=~s/\Q$pattern\E/$new/;      $newkey=~s/\Q$pattern\E/$new/;
Line 184  sub copyresourcedb { Line 212  sub copyresourcedb {
  }   }
     }      }
 #  transfer hash  #  transfer hash
     foreach my $key (keys %data) {      foreach my $key (keys(%data)) {
  my $thiskey=$key;   my $thiskey=$key;
  $thiskey=~s/^$origcrsid/$newcrsid/;   $thiskey=~s/^$origcrsid/$newcrsid/;
  $newdata{$thiskey}=$data{$key};   $newdata{$thiskey}=$data{$key};
Line 193  sub copyresourcedb { Line 221  sub copyresourcedb {
 # date_mode other: do not transfer dates  # date_mode other: do not transfer dates
         if (($date_mode) && ($date_mode ne 'preserve')) {          if (($date_mode) && ($date_mode ne 'preserve')) {
     if ($data{$key.'.type'}=~/^date_(start|end)$/) {      if ($data{$key.'.type'}=~/^date_(start|end)$/) {
        if ($date_mode eq 'shift') {          if ($date_mode eq 'shift') {
   $newdata{$thiskey}=$newdata{$thiskey}+$delta;                      if (($date_shift) && ($date_shift == int($date_shift))) { 
        } else {                          my $dt = DateTime->from_epoch(epoch => $newdata{$thiskey})
   delete($newdata{$thiskey});                                                        ->set_time_zone($origtz);
   delete($newdata{$thiskey.'.type'});                          if (($origtz eq 'local') && (!$ENV{TZ})) {
        }                              $ENV{TZ} = $dt->time_zone()->name();
                           }
                           eval {
                               $dt->add(days => int($date_shift));
                           };
                           if ($@) {
                               $newdata{$thiskey} = $newdata{$thiskey}+$delta+(60*60);
                           } else {
                               $newdata{$thiskey} = $dt->epoch();
                           }
                       } else {
                           $newdata{$thiskey} = $newdata{$thiskey}+$delta;
                       }
                   } else {
                       delete($newdata{$thiskey});
                       delete($newdata{$thiskey.'.type'});
                   }
             }              }
  }          }
     }      }
     return &Apache::lonnet::put      return &Apache::lonnet::put
  ('resourcedata',\%newdata,$newcrsdata{'domain'},$newcrsdata{'num'});   ('resourcedata',\%newdata,$newcrsdata{'domain'},$newcrsdata{'num'});
Line 219  sub copyuserfiles { Line 263  sub copyuserfiles {
 # ========================================================== Copy all userfiles  # ========================================================== Copy all userfiles
   
 sub copydbfiles {  sub copydbfiles {
     my ($origcrsid,$newcrsid)=@_;      my ($origcrsid,$newcrsid,$newinstcode)=@_;
   
     my ($origcrs_discussion) = ($origcrsid=~m|^/(.*)|);      my ($origcrs_discussion) = ($origcrsid=~m|^/(.*)|);
     $origcrs_discussion=~s|/|_|g;      $origcrs_discussion=~s|/|_|g;
     foreach (&crsdirlist($origcrsid)) {      foreach (&crsdirlist($origcrsid)) {
  if ($_=~/\.db$/) {   if ($_=~/\.db$/) {
     unless           unless ($_=~/^(nohist\_|disclikes|discussiontimes|classlist|versionupdate
              ($_=~/^(nohist\_|discussiontimes|classlist|versionupdate|resourcedata|\Q$origcrs_discussion\E|slots|slot_reservations|gradingqueue|reviewqueue|CODEs|groupmembership)/) {                  |resourcedata|\Q$origcrs_discussion\E|slots|slot_reservations
  &copydb($origcrsid,$newcrsid,$_);                  |gradingqueue|reviewqueue|CODEs|groupmembership|comm_block)/) {
      }              &copydb($origcrsid,$newcrsid,$_,$newinstcode);
           }
  }   }
     }      }
 }  }
Line 236  sub copydbfiles { Line 281  sub copydbfiles {
 # ======================================================= Copy all course files  # ======================================================= Copy all course files
   
 sub copycoursefiles {  sub copycoursefiles {
     my ($origcrsid,$newcrsid,$date_mode,$date_shift)=@_;      my ($origcrsid,$newcrsid,$date_mode,$date_shift,$newinstcode)=@_;
     &copyuserfiles($origcrsid,$newcrsid);      &copyuserfiles($origcrsid,$newcrsid);
     &copydbfiles($origcrsid,$newcrsid);      &copydbfiles($origcrsid,$newcrsid,$newinstcode);
     &copyresourcedb($origcrsid,$newcrsid,$date_mode,$date_shift);      &copyresourcedb($origcrsid,$newcrsid,$date_mode,$date_shift);
 }  }
   
 sub copyroster {  
     my ($origcrsid,$newcrsid,$accessstart,$accessend) = @_;  
     my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);  
     my $newcrsiddata=&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 $sec_idx  = &Apache::loncoursedata::CL_SECTION();  
     my $status_idx   = &Apache::loncoursedata::CL_STATUS();  
     my $end_idx = &Apache::loncoursedata::CL_END();  
     my $start_idx = &Apache::loncoursedata::CL_START();  
   
     my (%newstudents,%rolesadded,$numadded);  
     my $numadded = 0;  
     my $classlist = &Apache::loncoursedata::get_classlist();  
     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 @info = @{$classlist->{$student}};  
                     $info[$end_idx] = $accessend;  
                     $info[$start_idx] = $accessstart;  
                     $newstudents{$student}{'info'} = join(':',@info);  
                     $newstudents{$student}{'section'} =   
                         $classlist->{$student}->[$sec_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'};  
             }  
             if (&assignrole($sdom,$sname,$uurl,'st',$accessend,$accessstart,undef,undef,'requestcourses') eq 'ok') {  
                 $rolesadded{$student} = $newstudents{$student};  
                 $numadded ++ ;  
             }  
         }  
     }  
     my $clisterror;  
     if (keys(%rolesadded) > 0) {  
         my $reply=cput('classlist',\%rolesadded,$newcrsdata{'domain'},$newcrsdata{'num'});  
         unless (($reply eq 'ok') || ($reply eq 'delayed')) {  
             $clisterror = 'error: '.$reply;  
         }  
     }  
     return ($numadded,$clisterror);  
 }  
   
 1;  1;
Removed from v.1.7.12.1  
changed lines
  Added in v.1.14

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