--- loncom/interface/loncreatecourse.pm 2003/03/24 14:45:09 1.18 +++ 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.18 2003/03/24 14:45:09 www Exp $ +# $Id: loncreatecourse.pm,v 1.37 2003/09/09 17:26:03 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -48,6 +48,189 @@ 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 { @@ -66,6 +249,11 @@ sub print_course_creation_page { 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 @@ -104,24 +293,34 @@ $helplink

Course Content

+ + + +
Completely new courseClone an existing course

Map: -Browse +Select Map

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

-First Resource (standard courses only): +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: @@ -138,7 +337,9 @@ $helplink

Communication

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

Access Control

@@ -201,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 @@ -214,47 +420,74 @@ 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 ($ENV{'form.keys'}) { - $envflag=1; $cenv{'question.email'}=$ccuname.':'.$ccdomain; } } if ($ENV{'form.setkeys'}) { - $envflag=1; $cenv{'keyaccess'}='yes'; } if ($ENV{'form.disresdis'}) { - $envflag=1; $cenv{'pch.roles.denied'}='st'; } - if ($envflag) { - $r->print('Setting environment: '. + 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).'
'); @@ -297,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