--- loncom/interface/loncreatecourse.pm 2002/08/31 00:43:12 1.12 +++ 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.12 2002/08/31 00:43:12 www Exp $ +# $Id: loncreatecourse.pm,v 1.37 2003/09/09 17:26:03 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -45,6 +45,192 @@ 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')) { + ©file($origcrsid,$newcrsid,$_); + } +} +# ========================================================== Copy all userfiles + +sub copydbfiles { + my ($origcrsid,$newcrsid)=@_; + foreach (&crsdirlist($origcrsid)) { + if ($_=~/\.db$/) { + unless + ($_=~/^(nohist\_|discussiontimes|classlist|versionupdate|resourcedata)/) { + ©db($origcrsid,$newcrsid,$_); + } + } + } +} + +# ======================================================= 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 { @@ -53,13 +239,21 @@ sub print_course_creation_page { 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'); + 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(< +$coursebrowserjs The LearningOnline Network with CAPA $bodytag +$helplink

Course Information

Course Title:

-Map: - -Browse -

-Do NOT generate as standard course -(only check if you know what you are doing): - -

Course Home Server:$course_home

Course ID/Number (optional) +

+

Course Content

+ + + +
Completely new courseClone an existing course
+

+Map: + +Select Map

+Do NOT generate as standard course
+(only check if you know what you are doing): + +

+

+First Resource
(standard courses only): +Blank +  +Syllabus +  +Navigate +

+		 +Course ID: +
+Domain: +$cloneform
 
+Additional settings, if specified below, will override cloned settings. +
+

Assessment Parameters

+

Open all assessments: -

+

+

Messaging

+

Set course policy feedback to Course Coordinator:

Set content feedback to Course Coordinator:

- +

Communication

+

+Disable student resource discussion: +
+Disable student use of chatrooms: + +

+

Access Control

+

+Students need access key to enter course: + +

Course Coordinator

Username: @@ -170,11 +402,16 @@ ENDENHEAD # # 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.'
'); # # Check if created correctly @@ -183,40 +420,99 @@ ENDENHEAD my $crsuhome=&Apache::lonnet::homeserver($crsunum,$crsudom); $r->print('Created on: '.$crsuhome.'
'); # -# Set environment +# 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( + '
Attempting to clone non-existing course '.$cloneid.''); + } else { + $r->print( + '
Cloning course from '.$clonehome.''); + my %oldcenv=&Apache::lonnet::dump('environment',$crsudom,$crsunum); +# Copy all files + ©coursefiles($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) # - my %cenv=(); - my $envflag=0; if ($ENV{'form.crsid'}) { - $envflag=1; $cenv{'courseid'}=$ENV{'form.crsid'}; } if (($ccdomain) && ($ccuname)) { if ($ENV{'form.setpolicy'}) { - $envflag=1; $cenv{'policy.email'}=$ccuname.':'.$ccdomain; } if ($ENV{'form.setcontent'}) { - $envflag=1; $cenv{'question.email'}=$ccuname.':'.$ccdomain; } } - if ($envflag) { - $r->print('Setting environment: '. + 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('
Setting environment: '. &Apache::lonnet::put('environment',\%cenv,$crsudom,$crsunum).'
'); - } # # Open all assignments # if ($ENV{'form.openall'}) { my $storeunder=$crsudom.'_'.$crsunum.'.0.opendate'; - my %storecontent = ($storeunder => time, - $storeunder.'type' => 'date_start'); + my %storecontent = ($storeunder => time, + $storeunder.'.type' => 'date_start'); $r->print('Opening all assignments: '.&Apache::lonnet::cput ('resourcedata',\%storecontent,$crsudom,$crsunum).'
'); } - +# +# 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').'
'); + } # # Make current user course adminstrator # @@ -234,7 +530,11 @@ ENDENHEAD $ccuname.' at '.$ccdomain.': '. &Apache::lonnet::assignrole($ccdomain,$ccuname,$courseid,'cc').'

'); } - $r->print('Roles will be active at next login.'); + if ($ENV{'form.setkeys'}) { + $r->print( + '

Manage Access Keys

'); + } + $r->print('

Roles will be active at next login.

'); } # ===================================================================== Handler