--- loncom/interface/loncreatecourse.pm	2002/04/08 19:12:25	1.8
+++ loncom/interface/loncreatecourse.pm	2003/09/09 17:26:03	1.37
@@ -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.37 2003/09/09 17:26:03 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -44,13 +44,216 @@ 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);
+}
+
+# ===================================================================== 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'}.'/'
+            )));
+    }
+}
+
+# =============================================================== 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 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'};
+    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/) {
+	    $newdata{$thiskey}=$newdata{$thiskey}+$delta;
+	}
+    }
+    return &Apache::lonnet::put
+	('resourcedata',\%newdata,$newcrsdata{'domain'},$newcrsdata{'num'});
+}
+
+# ========================================================== Copy all userfiles
+
+sub copyuserfiles {
+    my ($origcrsid,$newcrsid)=@_;
+    foreach (&crsdirlist($origcrsid,'userfiles')) {
+	&copyfile($origcrsid,$newcrsid,$_);
+    }
+}
+# ========================================================== Copy all userfiles
+
+sub copydbfiles {
+    my ($origcrsid,$newcrsid)=@_;
+    foreach (&crsdirlist($origcrsid)) {
+	if ($_=~/\.db$/) {
+	    unless 
+             ($_=~/^(nohist\_|discussiontimes|classlist|versionupdate|resourcedata)/) {
+		 &copydb($origcrsid,$newcrsid,$_);
+	     }
+	}
+    }
+}
+
+# ======================================================= Copy all course files
+
+sub copycoursefiles {
+    my ($origcrsid,$newcrsid)=@_;
+    &copyuserfiles($origcrsid,$newcrsid);
+    &copydbfiles($origcrsid,$newcrsid);
+    &copyresourcedb($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 = '<select name="course_home" size="1">'."\n";
+    foreach my $server (sort(keys(%host_servers))) {
+        $course_home .= qq{<option value="$server"};
+        if ($server eq $Apache::lonnet::perlvar{'lonHostID'}) {
+            $course_home .= " selected ";
+        }
+        $course_home .= qq{>$server $host_servers{$server}</option>};
+    }
+    $course_home .= "\n</select>\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');
+    my $cloneform=&Apache::loncommon::select_dom_form
+	($ENV{'request.role.domain'},'clonedomain').
+		     &Apache::loncommon::selectcourse_link
+		     ('ccrs','clonecourse','clonedomain');
+    my $coursebrowserjs=&Apache::loncommon::coursebrowser_javascript();
     $r->print(<<ENDDOCUMENT);
 <html>
 <script language="JavaScript" type="text/javascript">
@@ -72,25 +275,89 @@ function openbrowser(formname,elementnam
     editbrowser.focus();
 }
 </script>
+$coursebrowserjs
 <head>
 <title>The LearningOnline Network with CAPA</title>
 </head>
-<body bgcolor="#FFFFFF">
-<img align="right" src="/adm/lonIcons/lonlogos.gif">
-<h1>Create a new Course</h1>
+$bodytag
+$helplink
 <form action="/adm/createcourse" method="post" name="ccrs">
-<h3>Course Title</h3>
+<h2>Course Information</h2>
+<p>
+<b>Course Title:</b>
 <input type="text" size="50" name="title">
-<h3>Top-level Map</h3>
-<input type="text" size="50" name="topmap">
-<a href="javascript:openbrowser('ccrs','topmap')">Browse</a>
-<h3>Course ID/Number (optional)</h3>
+</p><p>
+<b>Course Home Server:</b>$course_home
+</p><p>
+<b>Course ID/Number (optional)</b>
 <input type="text" size="30" name="crsid">
-<h3>Course Coordinator</h3>
-Username: <input type="text" size="15" name="ccuname" /><br>
-Domain:   <input type="text" size="15" name="ccdomain" value="$defdom" />
-<input type="hidden" name="phase" value="two" /><p>
+</p>
+<h2>Course Content</h2>
+<table border="2">
+<tr><th>Completely new course</th><th>Clone an existing course</th></tr>
+<tr><td>
+<p>
+<b>Map:</b>
+<input type="text" size="50" name="topmap">
+<a href="javascript:openbrowser('ccrs','topmap')">Select Map</a>
+</p><p>
+<b>Do NOT generate as standard course</b><br /> 
+(only check if you know what you are doing):
+<input type="checkbox" name="nonstandard">
+</p>
+<p>
+<b>First Resource</b><br />(standard courses only):
+<input type="radio" name="firstres" value="blank">Blank
+&nbsp;
+<input type="radio" name="firstres" value="syl" checked>Syllabus
+&nbsp;
+<input type="radio" name="firstres" value="nav">Navigate
+</p>
+</td><td>
+Course ID: <input input type="text" size="25" name="clonecourse" value="" />
+<br />
+Domain: 
+$cloneform<br />&nbsp;<br />
+Additional settings, if specified below, will override cloned settings.
+</td></tr>
+</table>
+<h2>Assessment Parameters</h2>
+<p>
+<b>Open all assessments: </b>
+<input type="checkbox" name="openall" checked>
+</p>
+<h2>Messaging</h2>
+<p>
+<b>Set course policy feedback to Course Coordinator: </b>
+<input type="checkbox" name="setpolicy" checked>
+</p><p>
+<b>Set content feedback to Course Coordinator: </b>
+<input type="checkbox" name="setcontent" checked>
+</p>
+<h2>Communication</h2>
+<p>
+<b>Disable student resource discussion: </b>
+<input type="checkbox" name="disresdis" /> <br />
+<b>Disable student use of chatrooms: </b>
+<input type="checkbox" name="disablechat" />
+</p>
+<h2>Access Control</h2>
+<p>
+<b>Students need access key to enter course: </b>
+<input type="checkbox" name="setkeys" />
+</p>
+<h2>Course Coordinator</h2>
+<p>
+<b>Username:</b> <input type="text" size="15" name="ccuname" />
+</p><p>
+<b>Domain:</b> $domform
+</p><p>
+<b>Immediately expire own role as Course Coordinator:</b>
+<input type="checkbox" name="expireown" checked>
+</p><p>
+<input type="hidden" name="phase" value="two" />
 <input type="submit" value="Open Course">
+</p>
 </form>
 </body>
 </html>
@@ -99,7 +366,7 @@ ENDDOCUMENT
 
 # ====================================================== Phase two: make course
 
-sub phase_two {
+sub create_course {
     my $r=shift;
     my $topurl='/res/'.&Apache::lonnet::declutter($ENV{'form.topmap'});
     my $ccuname=$ENV{'form.ccuname'};
@@ -108,56 +375,166 @@ sub phase_two {
     $ccdomain=~s/\W//g;
     my $cdescr=$ENV{'form.title'};
     my $curl=$ENV{'form.topmap'};
+    my $bodytag=&Apache::loncommon::bodytag('Create a New Course');
     $r->print(<<ENDENHEAD);
 <html>
 <head>
 <title>The LearningOnline Network with CAPA</title>
 </head>
-<body bgcolor="#FFFFFF">
-<img align=right src=/adm/lonIcons/lonlogos.gif>
-<h1>Create a new Course</h1>
+$bodytag
 ENDENHEAD
-#
-# Verify data
-#
+    #
+    # Verify data
+    #
+    # Check the veracity of the course coordinator
     if (&Apache::lonnet::homeserver($ccuname,$ccdomain) eq 'no_host') {
         $r->print('No such user '.$ccuname.' at '.$ccdomain.'</body></html>');
 	return;
     }
-
+    # Check the proposed home server for the course
+    my %host_servers = &Apache::loncommon::get_library_servers
+        ($ENV{'request.role.domain'});
+    if (! exists($host_servers{$ENV{'form.course_home'}})) {
+        $r->print('Invalid home server for course: '.
+                  $ENV{'form.course_home'}.'</body></html>');
+        return;
+    }
 #
 # Open course
 #
-    my $courseid=&Apache::lonnet::createcourse($ENV{'user.domain'},
-                                               $cdescr,$curl);
-
+    my %cenv=();
+    my $courseid=&Apache::lonnet::createcourse($ENV{'request.role.domain'},
+                                               $cdescr,$curl,
+                                               $ENV{'form.course_home'},
+                                               $ENV{'form.nonstandard'});
+
+    # Note: The testing routines depend on this being output; see 
+    # Utils::Course. This needs to at least be output as a comment
+    # if anyone ever decides to not show this, and Utils::Course::new
+    # will need to be suitably modified.
     $r->print('New LON-CAPA Course ID: '.$courseid.'<br>');
 #
-# Set optional courseid
+# Check if created correctly
 #
     my ($crsudom,$crsunum)=($courseid=~/^\/(\w+)\/(\w+)$/);
     my $crsuhome=&Apache::lonnet::homeserver($crsunum,$crsudom);
     $r->print('Created on: '.$crsuhome.'<br>');
+#
+# Are we cloning?
+#
+    my $cloneid='';
+    if (($ENV{'form.clonecourse'}) && ($ENV{'form.clonedomain'})) {
+	$cloneid='/'.$ENV{'form.clonedomain'}.'/'.$ENV{'form.clonecourse'};
+        my ($clonecrsudom,$clonecrsunum)=($cloneid=~/^\/(\w+)\/(\w+)$/);
+	my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
+	if ($clonehome eq 'no_host') {
+	    $r->print(
+    '<br /><font color="red">Attempting to clone non-existing course '.$cloneid.'</font>');
+	} else {
+	    $r->print(
+    '<br /><font color="green">Cloning course from '.$clonehome.'</font>');
+	    my %oldcenv=&Apache::lonnet::dump('environment',$crsudom,$crsunum);
+# Copy all files
+	    &copycoursefiles($cloneid,$courseid);
+# Restore URL
+	    $cenv{'url'}=$oldcenv{'url'};
+# Restore title
+	    $cenv{'description'}=$oldcenv{'description'};
+# Mark as cloned
+	    $cenv{'clonedfrom'}=$cloneid;
+	}
+    }
+#
+# Set environment (will override cloned, if existing)
+#
     if ($ENV{'form.crsid'}) {
-       $r->print('Setting optional Course ID/Number: '.                 
-           &Apache::lonnet::reply('put:'.$crsudom.':'.
-                                  $crsunum.':environment:courseid='.
-                                  &Apache::lonnet::escape($ENV{'form.crsid'}),
-                                  $crsuhome).'<br>');
+        $cenv{'courseid'}=$ENV{'form.crsid'};
+    }
+    if (($ccdomain) && ($ccuname)) {
+       if ($ENV{'form.setpolicy'}) {
+           $cenv{'policy.email'}=$ccuname.':'.$ccdomain;
+       }
+       if ($ENV{'form.setcontent'}) {
+           $cenv{'question.email'}=$ccuname.':'.$ccdomain;
+       }
+    }
+    if ($ENV{'form.setkeys'}) {
+       $cenv{'keyaccess'}='yes';
+    }
+    if ($ENV{'form.disresdis'}) {
+        $cenv{'pch.roles.denied'}='st';
     }
+    if ($ENV{'form.disablechat'}) {
+        $cenv{'plc.roles.denied'}='st';
+    }
+
+    # Record we've not yet viewed the Course Initialization Helper for this 
+    # course
+    $cenv{'course.helper.not.run'} = 1;
+    #
+    # Use new Randomseed
+    #
+    $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
+    #
+    # By default, use standard grading
+    $cenv{'grading'} = 'standard';
+
+    $r->print('<br />Setting environment: '.                 
+          &Apache::lonnet::put('environment',\%cenv,$crsudom,$crsunum).'<br>');
+#
+# Open all assignments
+#
+    if ($ENV{'form.openall'}) {
+       my $storeunder=$crsudom.'_'.$crsunum.'.0.opendate';
+       my %storecontent = ($storeunder         => time,
+                           $storeunder.'.type' => 'date_start');
+       
+       $r->print('Opening all assignments: '.&Apache::lonnet::cput
+                 ('resourcedata',\%storecontent,$crsudom,$crsunum).'<br>');
+   }
+#
+# Set first page
+#
+    unless (($ENV{'form.nonstandard'}) || ($ENV{'form.firstres'} eq 'blank')) {
+	$r->print('Setting first resource: ');
+        my ($errtext,$fatal)=
+           &Apache::londocs::mapread($crsunum,$crsudom,'default.sequence');
+        $r->print(($fatal?$errtext:'read ok').' - ');
+        my $title; my $url;
+        if ($ENV{'form.firstres'} eq 'syl') {
+	    $title='Syllabus';
+            $url='/public/'.$crsudom.'/'.$crsunum.'/syllabus';
+        } else {
+            $title='Navigate Contents';
+            $url='/adm/navmaps';
+        }
+        $Apache::lonratedt::resources[1]=$title.':'.$url.':false:start:res';
+        ($errtext,$fatal)=
+           &Apache::londocs::storemap($crsunum,$crsudom,'default.sequence');
+        $r->print(($fatal?$errtext:'write ok').'<br>');
+  }
 #
 # Make current user course adminstrator
 #
-    $r->print('Assigning role of course coordinator to self: '.
+    my $end=undef;
+    my $addition='';
+    if ($ENV{'form.expireown'}) { $end=time+5; $addition='expired'; }
+    $r->print('Assigning '.$addition.' role of course coordinator to self: '.
     &Apache::lonnet::assignrole(
-     $ENV{'user.domain'},$ENV{'user.name'},$courseid,'cc').'<br>');
+     $ENV{'user.domain'},$ENV{'user.name'},$courseid,'cc',$end).'<br>');
 #
 # Make additional user course administrator
 #
+   if (($ccdomain) && ($ccuname)) {
     $r->print('Assigning role of course coordinator to '.
                $ccuname.' at '.$ccdomain.': '.
     &Apache::lonnet::assignrole($ccdomain,$ccuname,$courseid,'cc').'<p>');
-    $r->print('Roles will be active at next login.</body></html>');
+   }
+    if ($ENV{'form.setkeys'}) {
+	$r->print(
+ '<p><a href="/adm/managekeys?cid='.$crsudom.'_'.$crsunum.'">Manage Access Keys</a></p>');
+    }
+    $r->print('<p>Roles will be active at next login.</p></body></html>');
 }
 
 # ===================================================================== Handler
@@ -170,14 +547,14 @@ sub handler {
        return OK;
     }
 
-    if (&Apache::lonnet::allowed('ccc',$ENV{'user.domain'})) {
+    if (&Apache::lonnet::allowed('ccc',$ENV{'request.role.domain'})) {
        $r->content_type('text/html');
        $r->send_http_header;
 
        if ($ENV{'form.phase'} eq 'two') {
-           &phase_two($r);
+           &create_course($r);
        } else {
-	   &phase_one($r);
+	   &print_course_creation_page($r);
        }
    } else {
       $ENV{'user.error.msg'}=