--- loncom/interface/loncreatecourse.pm 2002/04/08 19:12:25 1.8
+++ loncom/interface/loncreatecourse.pm 2003/09/02 18:00:14 1.31
@@ -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.31 2003/09/02 18:00:14 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -44,13 +44,128 @@ package Apache::loncreatecourse;
use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
+use Apache::loncommon;
+use Apache::lonratedt;
+use Apache::londocs;
+
+# -------------------------------------------- Return path to profile directory
+
+sub propath {
+ my ($udom,$uname)=@_;
+ $udom=~s/\W//g;
+ $uname=~s/\W//g;
+ my $subdir=$uname.'__';
+ $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
+ my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
+ return $proname;
+}
+
+# ================================================ Get course directory listing
+
+sub crsdirlist {
+ my ($courseid,$which)=@_;
+ unless ($which) { $which=''; }
+ my %crsdata=&Apache::lonnet::coursedescription($courseid);
+ my @listing=&Apache::lonnet::dirlist
+ ($which,$crsdata{'domain'},$crsdata{'num'},
+ &propath($crsdata{'domain'},$crsdata{'num'}));
+ my @output=();
+ foreach (@listing) {
+ unless ($_=~/^\./) {
+ push (@output,(split(/\&/,$_))[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'},
+ $crsdata{'home'},
+ 'output',$which);
+}
+
+# ============================================================= Copy a userfile
+
+sub copyfile {
+ my ($origcrsid,$newcrsid,$which)=@_;
+ return &writefile($newcrsid,$which,&readfile($origcrsid,$which));
+}
+
+# =============================================================== 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'});
+ return &Apache::lonnet::put
+ ($which,\%data,$newcrsdata{'domain'},$newcrsdata{'num'});
+}
+
+# ========================================================== Copy all userfiles
+
+sub copyuserfiles {
+ my ($origcrsid,$newcrsid)=@_;
+ foreach (&crsdirlist($origcrsid,'userfiles')) {
+ ©file($origcrsid,$newcrsid,$_);
+ }
+}
+# ========================================================== Copy all userfiles
+
+sub copydbfiles {
+ my ($origcrsid,$newcrsid)=@_;
+ foreach (&crsdirlist($origcrsid)) {
+ if ($_=~/\.db$/) {
+ unless
+ ($_=~/^(nohist\_|discussiontimes|classlist|versionupdate)/) {
+ ©db($origcrsid,$newcrsid,$_);
+ }
+ }
+ }
+}
+
+# ======================================================= Copy all course files
+
+sub copycoursefiles {
+ my ($origcrsid,$newcrsid)=@_;
+ ©userfiles($origcrsid,$newcrsid);
+ ©dbfiles($origcrsid,$newcrsid);
+}
# ===================================================== Phase one: fill-in form
-sub phase_one {
+sub print_course_creation_page {
my $r=shift;
-
- my $defdom=$ENV{'user.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(<