--- loncom/interface/loncreatecourse.pm	2001/02/15 00:57:41	1.1
+++ loncom/interface/loncreatecourse.pm	2003/11/12 21:37:07	1.39
@@ -1,5 +1,30 @@
 # The LearningOnline Network
 # Create a course
+#
+# $Id: loncreatecourse.pm,v 1.39 2003/11/12 21:37:07 albertel Exp $
+#
+# Copyright Michigan State University Board of Trustees
+#
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
+#
+# LON-CAPA is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# LON-CAPA is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with LON-CAPA; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+#
+# /home/httpd/html/adm/gpl.txt
+#
+# http://www.lon-capa.org/
+#
 # (My Desk
 #
 # (Internal Server Error Handler
@@ -12,40 +37,514 @@
 #
 # 3/1 Gerd Kortemeyer)
 #
-# 2/14 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;
 
-sub handler {
-    my $r = shift;
+# ================================================ Get course directory listing
 
-    if ($r->header_only) {
-       $r->content_type('text/html');
-       $r->send_http_header;
-       return OK;
+sub crsdirlist {
+    my ($courseid,$which)=@_;
+    unless ($which) { $which=''; }
+    my %crsdata=&Apache::lonnet::coursedescription($courseid);
+    my @listing=&Apache::lonnet::dirlist
+	($which,$crsdata{'domain'},$crsdata{'num'},
+	 &Apache::loncommon::propath($crsdata{'domain'},$crsdata{'num'}));
+    my @output=();
+    foreach (@listing) {
+	unless ($_=~/^\./) {
+	    push (@output,(split(/\&/,$_))[0]);
+	}
     }
+    return @output;
+}
 
-    if (&Apache::lonnet::allowed('ccc',$ENV{'user.domain'})) {
-       $r->content_type('text/html');
-       $r->send_http_header;
+# ============================================================= 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 print_course_creation_page {
+    my $r=shift;
+    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">
+var editbrowser = null;
+function openbrowser(formname,elementname) {
+    var url = '/res/?';
+    if (editbrowser == null) {
+        url += 'launch=1&';
+    }
+    url += 'catalogmode=interactive&';
+    url += 'mode=edit&';
+    url += 'form=' + formname + '&';
+    url += 'element=' + elementname + '&';
+    url += 'only=sequence' + '';
+    var title = 'Browser';
+    var options = 'scrollbars=1,resizable=1,menubar=0';
+    options += ',width=700,height=600';
+    editbrowser = open(url,title,options,'1');
+    editbrowser.focus();
+}
+</script>
+$coursebrowserjs
 <head>
 <title>The LearningOnline Network with CAPA</title>
 </head>
-<body bgcolor="#FFFFFF">
-<h1>Create a new Course</h1>
-<img src="/adm/lonKaputt/lonconstruct.gif">
+$bodytag
+$helplink
+<form action="/adm/createcourse" method="post" name="ccrs">
+<h2>Course Information</h2>
+<p>
+<b>Course Title:</b>
+<input type="text" size="50" name="title">
+</p><p>
+<b>Course Home Server:</b>$course_home
+</p><p>
+<b>Course ID/Number (optional)</b>
+<input type="text" size="30" name="crsid">
+</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>
 ENDDOCUMENT
+}
+
+# ====================================================== Phase two: make course
+
+sub create_course {
+    my $r=shift;
+    my $topurl='/res/'.&Apache::lonnet::declutter($ENV{'form.topmap'});
+    my $ccuname=$ENV{'form.ccuname'};
+    my $ccdomain=$ENV{'form.ccdomain'};
+    $ccuname=~s/\W//g;
+    $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>
+$bodytag
+ENDENHEAD
+    #
+    # 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 %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>');
+#
+# 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'}) {
+        $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
+#
+    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',$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>');
+   }
+    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
+sub handler {
+    my $r = shift;
+
+    if ($r->header_only) {
+       &Apache::loncommon::content_type($r,'text/html');
+       $r->send_http_header;
+       return OK;
+    }
+
+    if (&Apache::lonnet::allowed('ccc',$ENV{'request.role.domain'})) {
+       &Apache::loncommon::content_type($r,'text/html');
+       $r->send_http_header;
 
+       if ($ENV{'form.phase'} eq 'two') {
+           &create_course($r);
+       } else {
+	   &print_course_creation_page($r);
+       }
    } else {
       $ENV{'user.error.msg'}=
         "/adm/createcourse:ccc:0:0:Cannot create courses";