--- loncom/interface/loncreatecourse.pm 2002/04/08 19:12:25 1.8
+++ loncom/interface/loncreatecourse.pm 2006/05/30 12:46:09 1.89
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Create a course
#
-# $Id: loncreatecourse.pm,v 1.8 2002/04/08 19:12:25 matthew Exp $
+# $Id: loncreatecourse.pm,v 1.89 2006/05/30 12:46:09 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,35 +25,334 @@
#
# http://www.lon-capa.org/
#
-# (My Desk
-#
-# (Internal Server Error Handler
-#
-# (Login Screen
-# 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14,
-# 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer)
-#
-# 3/1/1 Gerd Kortemeyer)
-#
-# 3/1 Gerd Kortemeyer)
-#
-# 2/14,2/16,2/17,7/6 Gerd Kortemeyer
-#
+###
+
package Apache::loncreatecourse;
use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
+use Apache::loncommon;
+use Apache::lonratedt;
+use Apache::londocs;
+use Apache::lonlocal;
+use Apache::londropadd;
+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,$_);
+ my $histfile=$_;
+ $histfile=~s/\.db$/\.hist/;
+ ©file($origcrsid,$newcrsid,$histfile);
+ }
+ }
+ }
+}
+
+# ======================================================= Copy all course files
+
+sub copycoursefiles {
+ my ($origcrsid,$newcrsid)=@_;
+ ©userfiles($origcrsid,$newcrsid);
+ ©dbfiles($origcrsid,$newcrsid);
+ ©resourcedb($origcrsid,$newcrsid);
+}
# ===================================================== Phase one: fill-in form
-sub phase_one {
+sub print_course_creation_page {
my $r=shift;
-
- my $defdom=$ENV{'user.domain'};
- $r->print(<
-
+
+
+
+
+
+
+
+
+$lt{'stat'}
+
+
+
+
+
+
+
+
+$lt{'smap'}
+
+
+
+$lt{'fres'}
+
+
+
+
+
+
+
+
+
+
+Create a new Course
+$coursebrowserjs
+END
+
+ my $start_page =
+ &Apache::loncommon::start_page('Create a New Course',$js);
+ my $end_page =
+ &Apache::loncommon::end_page();
+
+ $r->print(<Course Title
-
-Top-level Map
-
-Browse
-Course ID/Number (optional)
-
-Course Coordinator
-Username:
-Domain:
-$lt{'cinf'}
+$lt{'iinf'}
+
+($lt{'toin'})
+
+($lt{'csli'})
+
+($lt{'cscs'})
+$lt{'crco'}
+
+
+
+$lt{'cncr'} $lt{'cecr'}
+
+
+($lt{'ocik'}):
+
+
($lt{'stco'}):
+
+
+
+
+
+
+
+
+
+
+
+$lt{'asov'}.
+$lt{'assp'}
+$lt{'mssg'}
+
+
+$lt{'cmmn'}
+
+
+$lt{'acco'}
+
+
+$lt{'rshm'}
+$lt{'aens'}
+$lt{'aesc'}
+
+$lt{'aadd'} + + +
+$lt{'audr'} + + +
+$lt{'dacu'} +$enroll_table +
+$lt{'dacc'} +$access_table +
+$lt{'psam'}.
+$krbform
+
+$intform
+
+$locform
+
+$lt{'nech'}
+$lt{'nccl'}
+
+
+
+$lt{'ndcl'}
+
+
+
+$lt{'irsp'} + + +
++ +
+ +
++ + +
- -