![]() ![]() | ![]() |
- consoladating the 3 different &propath()s
# 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 # # (Login Screen # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14, # 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer) # # 3/1/1 Gerd Kortemeyer) # # 3/1 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; # ================================================ 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'}, &Apache::loncommon::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 { 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> $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 <input type="radio" name="firstres" value="syl" checked>Syllabus <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 /> <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 ©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) # 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"; return HTTP_NOT_ACCEPTABLE; } return OK; } 1; __END__