--- loncom/interface/loncreatecourse.pm 2003/05/04 07:38:32 1.22
+++ loncom/interface/loncreatecourse.pm 2006/05/11 01:16:44 1.87
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Create a course
#
-# $Id: loncreatecourse.pm,v 1.22 2003/05/04 07:38:32 albertel Exp $
+# $Id: loncreatecourse.pm,v 1.87 2006/05/11 01:16:44 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,20 +25,8 @@
#
# 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;
@@ -47,12 +35,229 @@ use Apache::lonnet;
use Apache::loncommon;
use Apache::lonratedt;
use Apache::londocs;
+use Apache::lonlocal;
+use Apache::londropadd;
+use lib '/home/httpd/lib/perl';
+
+# ================================================ 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'},
+ &Apache::loncommon::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|(grading|review)queue|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 print_course_creation_page {
my $r=shift;
- my $defdom=$ENV{'request.role.domain'};
+ my $defdom=$env{'request.role.domain'};
my %host_servers = &Apache::loncommon::get_library_servers($defdom);
my $course_home = '\n";
my $domform = &Apache::loncommon::select_dom_form($defdom,'ccdomain');
- my $bodytag=&Apache::loncommon::bodytag('Create a New Course');
- my $helplink=&Apache::loncommon::help_open_topic('Create_Course','Help on Creating Courses');
- $r->print(<
-Course Title:
-
+
-Course Home Server:$course_home
+
-Course ID/Number (optional)
-
-Course Information
+$lt{'cinf'}
Course Content
+
+
+
-Map: - -Browse +$lt{'stat'} +
+
+
+($lt{'toin'})
+
+
+
+($lt{'csli'})
-Do NOT generate as standard course
-(only check if you know what you are doing):
-
+
+
+($lt{'cscs'})
$lt{'cncr'} | $lt{'cecr'} |
---|---|
-First Resource (standard courses only): -Blank + +$lt{'smap'} +
+
+
+$lt{'fres'} Assessment Parameters+ |
+
+ + + + +$lt{'asov'}. + |
-Open all assessments: - +
--Set course policy feedback to Course Coordinator: - -
-Set content feedback to Course Coordinator:
-
+
+
+
-Disable student resource discussion:
-
+
+
+
-Students need access key to enter course:
-
+
+
+
-Username: + +
++
+$lt{'aadd'} + + +
+$lt{'audr'} + + +
+$lt{'dacu'} +$enroll_table +
+$lt{'dacc'} +$access_table +
+$lt{'psam'}.
+$krbform
+
+$intform
+
+$locform
-Domain: $domform
+$lt{'nech'}
+$lt{'nccl'}
+
+
+
+$lt{'ndcl'}
+
+
-Immediately expire own role as Course Coordinator: - +$lt{'irsp'} + + +
++
+ +
+- +
-