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

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

version 1.4, 2008/01/18 17:51:18 version 1.7.12.1, 2010/02/26 22:45:03
Line 30 Line 30
 package Apache::lonclonecourse;  package Apache::lonclonecourse;
 use LONCAPA;  use LONCAPA;
 use Apache::lonnet;  use Apache::lonnet;
   use Apache::loncoursedata;
   
 # ================================================ Get course directory listing  # ================================================ Get course directory listing
   
Line 47  sub innercrsdirlist { Line 48  sub innercrsdirlist {
     unless ($which) { $which=''; } else { $which.='/'; }      unless ($which) { $which=''; } else { $which.='/'; }
     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 @listing=&Apache::lonnet::dirlist      my @listing=&Apache::lonnet::dirlist
  ($which,$crsdata{'domain'},$crsdata{'num'},   ($which,$crsdata{'domain'},$crsdata{'num'},$getpropath);
  &propath($crsdata{'domain'},$crsdata{'num'}));  
     foreach (@listing) {      foreach (@listing) {
  unless ($_=~/^\./) {   unless ($_=~/^\./) {
     my @unpackline = split (/\&/,$_);      my @unpackline = split (/\&/,$_);
Line 141  sub copydb { Line 142  sub copydb {
 # ========================================================== Copy resourcesdata  # ========================================================== Copy resourcesdata
   
 sub copyresourcedb {  sub copyresourcedb {
     my ($origcrsid,$newcrsid)=@_;      my ($origcrsid,$newcrsid,$date_mode,$date_shift)=@_;
       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 %data=&Apache::lonnet::dump      my %data=&Apache::lonnet::dump
Line 161  sub copyresourcedb { Line 163  sub copyresourcedb {
   
  $startdate = $start{'default_enrollment_start_date'};   $startdate = $start{'default_enrollment_start_date'};
     }      }
     my $today=time;  
     my $delta=0;  
     if ($startdate) {  
  my $oneday=60*60*24;  
  $delta=$today-$startdate;  
  $delta=int($delta/$oneday)*$oneday;  
     }  
 # ugly retro fix for broken version of types  # ugly retro fix for broken version of types
     foreach (keys %data) {      foreach my $key (keys %data) {
  if ($_=~/\wtype$/) {   if ($key=~/\wtype$/) {
     my $newkey=$_;      my $newkey=$key;
     $newkey=~s/type$/\.type/;      $newkey=~s/type$/\.type/;
     $data{$newkey}=$data{$_};      $data{$newkey}=$data{$key};
     delete $data{$_};      delete $data{$key};
  }   }
     }      }
 # 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 (keys %data) {      foreach my $key (keys %data) {
  if ($_=~/\Q$pattern\E/) {   if ($key=~/\Q$pattern\E/) {
     my $newkey=$_;      my $newkey=$key;
     $newkey=~s/\Q$pattern\E/$new/;      $newkey=~s/\Q$pattern\E/$new/;
     $data{$newkey}=$data{$_};      $data{$newkey}=$data{$key};
     delete $data{$_};      delete $data{$key};
  }   }
     }      }
 # adjust dates  #  transfer hash
     foreach (keys %data) {      foreach my $key (keys %data) {
  my $thiskey=$_;   my $thiskey=$key;
  $thiskey=~s/^$origcrsid/$newcrsid/;   $thiskey=~s/^$origcrsid/$newcrsid/;
  $newdata{$thiskey}=$data{$_};   $newdata{$thiskey}=$data{$key};
  if ($data{$_.'.type'}=~/^date_(start|end)$/) {  # date_mode empty or "preserve": transfer dates one-to-one
     if ($delta > 0) {  # date_mode "shift": shift dates by date_shift days
  $newdata{$thiskey}=$newdata{$thiskey}+$delta;  # date_mode other: do not transfer dates
     } else {          if (($date_mode) && ($date_mode ne 'preserve')) {
  # no delta, it's unlikely we want the old dates and times      if ($data{$key.'.type'}=~/^date_(start|end)$/) {
  delete($newdata{$thiskey});         if ($date_mode eq 'shift') {
  delete($newdata{$thiskey.'.type'});    $newdata{$thiskey}=$newdata{$thiskey}+$delta;
     }         } else {
     delete($newdata{$thiskey});
     delete($newdata{$thiskey.'.type'});
          }
               }
  }   }
     }      }
     return &Apache::lonnet::put      return &Apache::lonnet::put
Line 237  sub copydbfiles { Line 236  sub copydbfiles {
 # ======================================================= Copy all course files  # ======================================================= Copy all course files
   
 sub copycoursefiles {  sub copycoursefiles {
     my ($origcrsid,$newcrsid)=@_;      my ($origcrsid,$newcrsid,$date_mode,$date_shift)=@_;
     &copyuserfiles($origcrsid,$newcrsid);      &copyuserfiles($origcrsid,$newcrsid);
     &copydbfiles($origcrsid,$newcrsid);      &copydbfiles($origcrsid,$newcrsid);
     &copyresourcedb($origcrsid,$newcrsid);      &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.4  
changed lines
  Added in v.1.7.12.1

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