--- loncom/interface/loncreatecourse.pm 2006/08/19 06:14:09 1.93.2.6 +++ loncom/interface/loncreatecourse.pm 2006/07/11 02:28:22 1.94 @@ -1,7 +1,7 @@ # The LearningOnline Network # Create a course # -# $Id: loncreatecourse.pm,v 1.93.2.6 2006/08/19 06:14:09 albertel Exp $ +# $Id: loncreatecourse.pm,v 1.94 2006/07/11 02:28:22 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -37,19 +37,229 @@ use Apache::lonratedt; use Apache::londocs; use Apache::lonlocal; use Apache::londropadd; -use Apache::lonclonecourse; use LONCAPA::batchcreatecourse; +use lib '/home/httpd/lib/perl'; use LONCAPA; +# ================================================ Get course directory listing + +my @output=(); + +sub crsdirlist { + my ($courseid,$which)=@_; + @output=(); + return &innercrsdirlist($courseid,$which); +} + +sub innercrsdirlist { + my ($courseid,$which,$path)=@_; + my $dirptr=16384; + 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) { +# is a directory, recurse + &innercrsdirlist($courseid,$which.$unpackline[0], + $path.$unpackline[0]); + } else { +# is a file, put into output + push (@output,$path.$unpackline[0]); + } + } + } + return @output; +} + +# ============================================================= Read a userfile + +sub readfile { + my ($courseid,$which)=@_; + my %crsdata=&Apache::lonnet::coursedescription($courseid); + return &Apache::lonnet::getfile('/uploaded/'.$crsdata{'domain'}.'/'. + $crsdata{'num'}.'/'.$which); +} + +# ============================================================ Write a userfile + +sub writefile { + (my $courseid, my $which,$env{'form.output'})=@_; + my %crsdata=&Apache::lonnet::coursedescription($courseid); + return &Apache::lonnet::finishuserfileupload( + $crsdata{'num'},$crsdata{'domain'}, + 'output',$which); +} + +# ===================================================================== Rewrite + +sub rewritefile { + my ($contents,%rewritehash)=@_; + foreach (keys %rewritehash) { + my $pattern=$_; + $pattern=~s/(\W)/\\$1/gs; + my $new=$rewritehash{$_}; + $contents=~s/$pattern/$new/gs; + } + return $contents; +} + +# ============================================================= Copy a userfile + +sub copyfile { + my ($origcrsid,$newcrsid,$which)=@_; + unless ($which=~/\.sequence$/) { + return &writefile($newcrsid,$which, + &readfile($origcrsid,$which)); + } else { + my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid); + my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid); + return &writefile($newcrsid,$which, + &rewritefile( + &readfile($origcrsid,$which), + ( + '/uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/' + => '/uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/', + '/public/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/' + => '/public/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/' + ))); + } +} + +# =============================================================== Copy a dbfile + +sub copydb { + my ($origcrsid,$newcrsid,$which)=@_; + $which=~s/\.db$//; + my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid); + my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid); + my %data=&Apache::lonnet::dump + ($which,$origcrsdata{'domain'},$origcrsdata{'num'}); + foreach my $key (keys(%data)) { + if ($key=~/^internal./) { delete($data{$key}); } + } + return &Apache::lonnet::put + ($which,\%data,$newcrsdata{'domain'},$newcrsdata{'num'}); +} + +# ========================================================== Copy resourcesdata + +sub copyresourcedb { + my ($origcrsid,$newcrsid)=@_; + my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid); + my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid); + my %data=&Apache::lonnet::dump + ('resourcedata',$origcrsdata{'domain'},$origcrsdata{'num'}); + $origcrsid=~s/^\///; + $origcrsid=~s/\//\_/; + $newcrsid=~s/^\///; + $newcrsid=~s/\//\_/; + my %newdata=(); + undef %newdata; + my $startdate=$data{$origcrsid.'.0.opendate'}; + if (!$startdate) { + # now global start date for assements try the enrollment start + my %start=&Apache::lonnet::get('environment', + ['default_enrollment_start_date'], + $origcrsdata{'domain'},$origcrsdata{'num'}); + + $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 + foreach (keys %data) { + if ($_=~/\wtype$/) { + my $newkey=$_; + $newkey=~s/type$/\.type/; + $data{$newkey}=$data{$_}; + delete $data{$_}; + } + } +# adjust symbs + my $pattern='uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'; + $pattern=~s/(\W)/\\$1/gs; + my $new= 'uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/'; + foreach (keys %data) { + if ($_=~/$pattern/) { + my $newkey=$_; + $newkey=~s/$pattern/$new/; + $data{$newkey}=$data{$_}; + delete $data{$_}; + } + } +# adjust dates + foreach (keys %data) { + my $thiskey=$_; + $thiskey=~s/^$origcrsid/$newcrsid/; + $newdata{$thiskey}=$data{$_}; + if ($data{$_.'.type'}=~/^date_(start|end)$/) { + if ($delta > 0) { + $newdata{$thiskey}=$newdata{$thiskey}+$delta; + } else { + # no delta, it's unlikely we want the old dates and times + delete($newdata{$thiskey}); + delete($newdata{$thiskey.'.type'}); + } + } + } + return &Apache::lonnet::put + ('resourcedata',\%newdata,$newcrsdata{'domain'},$newcrsdata{'num'}); +} + +# ========================================================== Copy all userfiles + +sub copyuserfiles { + my ($origcrsid,$newcrsid)=@_; + foreach (&crsdirlist($origcrsid,'userfiles')) { + if ($_ !~m|^scantron_|) { + ©file($origcrsid,$newcrsid,$_); + } + } +} +# ========================================================== Copy all userfiles + +sub copydbfiles { + my ($origcrsid,$newcrsid)=@_; + + my ($origcrs_discussion) = ($origcrsid=~m|^/(.*)|); + $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)/) { + ©db($origcrsid,$newcrsid,$_); + } + } + } +} + +# ======================================================= Copy all course files + +sub copycoursefiles { + my ($origcrsid,$newcrsid)=@_; + ©userfiles($origcrsid,$newcrsid); + ©dbfiles($origcrsid,$newcrsid); + ©resourcedb($origcrsid,$newcrsid); +} + # ===================================================== Phase one: fill-in form sub print_course_creation_page { my $r=shift; - my $crstype = 'Course'; -# my $crstype = 'Group'; -# if ($env{'form.phase'} eq 'courseone') { -# $crstype = 'Course'; -# } + my $crstype = 'Group'; + if ($env{'form.phase'} eq 'courseone') { + $crstype = 'Course'; + } my $defdom=$env{'request.role.domain'}; my %host_servers = &Apache::loncommon::get_library_servers($defdom); my $course_home = ''.