--- loncom/interface/lonclonecourse.pm	2008/01/21 17:47:21	1.5
+++ loncom/interface/lonclonecourse.pm	2010/02/26 22:45:03	1.7.12.1
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # routines for clone a course
 #
-# $Id: lonclonecourse.pm,v 1.5 2008/01/21 17:47:21 www Exp $
+# $Id: lonclonecourse.pm,v 1.7.12.1 2010/02/26 22:45:03 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -30,6 +30,7 @@
 package Apache::lonclonecourse;
 use LONCAPA;
 use Apache::lonnet;
+use Apache::loncoursedata;
 
 # ================================================ Get course directory listing
 
@@ -47,9 +48,9 @@ sub innercrsdirlist {
     unless ($which) { $which=''; } else { $which.='/'; }
     unless ($path)  { $path=''; } else { $path.='/'; }
     my %crsdata=&Apache::lonnet::coursedescription($courseid);
+    my $getpropath = 1;
     my @listing=&Apache::lonnet::dirlist
-	($which,$crsdata{'domain'},$crsdata{'num'},
-	 &propath($crsdata{'domain'},$crsdata{'num'}));
+	($which,$crsdata{'domain'},$crsdata{'num'},$getpropath);
     foreach (@listing) {
 	unless ($_=~/^\./) {
 	    my @unpackline = split (/\&/,$_);
@@ -141,7 +142,8 @@ sub copydb {
 # ========================================================== Copy resourcesdata
 
 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 %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
     my %data=&Apache::lonnet::dump
@@ -162,23 +164,42 @@ sub copyresourcedb {
 	$startdate = $start{'default_enrollment_start_date'};
     }
 # ugly retro fix for broken version of types
-    foreach (keys %data) {
-	if ($_=~/\wtype$/) {
-	    my $newkey=$_;
+    foreach my $key (keys %data) {
+	if ($key=~/\wtype$/) {
+	    my $newkey=$key;
 	    $newkey=~s/type$/\.type/;
-	    $data{$newkey}=$data{$_};
-	    delete $data{$_};
+	    $data{$newkey}=$data{$key};
+	    delete $data{$key};
 	}
     }
 # adjust symbs
     my $pattern='uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/';
     my $new=    'uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/';
-    foreach (keys %data) {
-	if ($_=~/\Q$pattern\E/) {
-	    my $newkey=$_;
+    foreach my $key (keys %data) {
+	if ($key=~/\Q$pattern\E/) {
+	    my $newkey=$key;
 	    $newkey=~s/\Q$pattern\E/$new/;
-	    $data{$newkey}=$data{$_};
-	    delete $data{$_};
+	    $data{$newkey}=$data{$key};
+	    delete $data{$key};
+	}
+    }
+#  transfer hash
+    foreach my $key (keys %data) {
+	my $thiskey=$key;
+	$thiskey=~s/^$origcrsid/$newcrsid/;
+	$newdata{$thiskey}=$data{$key};
+# date_mode empty or "preserve": transfer dates one-to-one
+# date_mode "shift": shift dates by date_shift days
+# 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'});
+	       }
+            }
 	}
     }
     return &Apache::lonnet::put
@@ -215,10 +236,73 @@ sub copydbfiles {
 # ======================================================= Copy all course files
 
 sub copycoursefiles {
-    my ($origcrsid,$newcrsid)=@_;
+    my ($origcrsid,$newcrsid,$date_mode,$date_shift)=@_;
     &copyuserfiles($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;