![]() ![]() | ![]() |
- consoladating the 3 different &propath()s
1: # The LearningOnline Network 2: # Create a course 3: # 4: # $Id: loncreatecourse.pm,v 1.39 2003/11/12 21:37:07 albertel Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: # (My Desk 29: # 30: # (Internal Server Error Handler 31: # 32: # (Login Screen 33: # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14, 34: # 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer) 35: # 36: # 3/1/1 Gerd Kortemeyer) 37: # 38: # 3/1 Gerd Kortemeyer) 39: # 40: # 2/14,2/16,2/17,7/6 Gerd Kortemeyer 41: # 42: package Apache::loncreatecourse; 43: 44: use strict; 45: use Apache::Constants qw(:common :http); 46: use Apache::lonnet; 47: use Apache::loncommon; 48: use Apache::lonratedt; 49: use Apache::londocs; 50: use Apache::lonlocal; 51: 52: # ================================================ Get course directory listing 53: 54: sub crsdirlist { 55: my ($courseid,$which)=@_; 56: unless ($which) { $which=''; } 57: my %crsdata=&Apache::lonnet::coursedescription($courseid); 58: my @listing=&Apache::lonnet::dirlist 59: ($which,$crsdata{'domain'},$crsdata{'num'}, 60: &Apache::loncommon::propath($crsdata{'domain'},$crsdata{'num'})); 61: my @output=(); 62: foreach (@listing) { 63: unless ($_=~/^\./) { 64: push (@output,(split(/\&/,$_))[0]); 65: } 66: } 67: return @output; 68: } 69: 70: # ============================================================= Read a userfile 71: 72: sub readfile { 73: my ($courseid,$which)=@_; 74: my %crsdata=&Apache::lonnet::coursedescription($courseid); 75: return &Apache::lonnet::getfile('/uploaded/'.$crsdata{'domain'}.'/'. 76: $crsdata{'num'}.'/'.$which); 77: } 78: 79: # ============================================================ Write a userfile 80: 81: sub writefile { 82: (my $courseid, my $which,$ENV{'form.output'})=@_; 83: my %crsdata=&Apache::lonnet::coursedescription($courseid); 84: return &Apache::lonnet::finishuserfileupload( 85: $crsdata{'num'},$crsdata{'domain'}, 86: $crsdata{'home'}, 87: 'output',$which); 88: } 89: 90: # ===================================================================== Rewrite 91: 92: sub rewritefile { 93: my ($contents,%rewritehash)=@_; 94: foreach (keys %rewritehash) { 95: my $pattern=$_; 96: $pattern=~s/(\W)/\\$1/gs; 97: my $new=$rewritehash{$_}; 98: $contents=~s/$pattern/$new/gs; 99: } 100: return $contents; 101: } 102: 103: # ============================================================= Copy a userfile 104: 105: sub copyfile { 106: my ($origcrsid,$newcrsid,$which)=@_; 107: unless ($which=~/\.sequence$/) { 108: return &writefile($newcrsid,$which, 109: &readfile($origcrsid,$which)); 110: } else { 111: my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid); 112: my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid); 113: return &writefile($newcrsid,$which, 114: &rewritefile( 115: &readfile($origcrsid,$which), 116: ( 117: '/uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/' 118: => '/uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/' 119: ))); 120: } 121: } 122: 123: # =============================================================== Copy a dbfile 124: 125: sub copydb { 126: my ($origcrsid,$newcrsid,$which)=@_; 127: $which=~s/\.db$//; 128: my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid); 129: my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid); 130: my %data=&Apache::lonnet::dump 131: ($which,$origcrsdata{'domain'},$origcrsdata{'num'}); 132: return &Apache::lonnet::put 133: ($which,\%data,$newcrsdata{'domain'},$newcrsdata{'num'}); 134: } 135: 136: # ========================================================== Copy resourcesdata 137: 138: sub copyresourcedb { 139: my ($origcrsid,$newcrsid)=@_; 140: my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid); 141: my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid); 142: my %data=&Apache::lonnet::dump 143: ('resourcedata',$origcrsdata{'domain'},$origcrsdata{'num'}); 144: $origcrsid=~s/^\///; 145: $origcrsid=~s/\//\_/; 146: $newcrsid=~s/^\///; 147: $newcrsid=~s/\//\_/; 148: my %newdata=(); 149: undef %newdata; 150: my $startdate=$data{$origcrsid.'.0.opendate'}; 151: my $today=time; 152: my $delta=0; 153: if ($startdate) { 154: my $oneday=60*60*24; 155: $delta=$today-$startdate; 156: $delta=int($delta/$oneday)*$oneday; 157: } 158: # ugly retro fix for broken version of types 159: foreach (keys %data) { 160: if ($_=~/\wtype$/) { 161: my $newkey=$_; 162: $newkey=~s/type$/\.type/; 163: $data{$newkey}=$data{$_}; 164: delete $data{$_}; 165: } 166: } 167: # adjust symbs 168: my $pattern='uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'; 169: $pattern=~s/(\W)/\\$1/gs; 170: my $new= 'uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/'; 171: foreach (keys %data) { 172: if ($_=~/$pattern/) { 173: my $newkey=$_; 174: $newkey=~s/$pattern/$new/; 175: $data{$newkey}=$data{$_}; 176: delete $data{$_}; 177: } 178: } 179: # adjust dates 180: foreach (keys %data) { 181: my $thiskey=$_; 182: $thiskey=~s/^$origcrsid/$newcrsid/; 183: $newdata{$thiskey}=$data{$_}; 184: if ($data{$_.'.type'}=~/^date/) { 185: $newdata{$thiskey}=$newdata{$thiskey}+$delta; 186: } 187: } 188: return &Apache::lonnet::put 189: ('resourcedata',\%newdata,$newcrsdata{'domain'},$newcrsdata{'num'}); 190: } 191: 192: # ========================================================== Copy all userfiles 193: 194: sub copyuserfiles { 195: my ($origcrsid,$newcrsid)=@_; 196: foreach (&crsdirlist($origcrsid,'userfiles')) { 197: ©file($origcrsid,$newcrsid,$_); 198: } 199: } 200: # ========================================================== Copy all userfiles 201: 202: sub copydbfiles { 203: my ($origcrsid,$newcrsid)=@_; 204: foreach (&crsdirlist($origcrsid)) { 205: if ($_=~/\.db$/) { 206: unless 207: ($_=~/^(nohist\_|discussiontimes|classlist|versionupdate|resourcedata)/) { 208: ©db($origcrsid,$newcrsid,$_); 209: } 210: } 211: } 212: } 213: 214: # ======================================================= Copy all course files 215: 216: sub copycoursefiles { 217: my ($origcrsid,$newcrsid)=@_; 218: ©userfiles($origcrsid,$newcrsid); 219: ©dbfiles($origcrsid,$newcrsid); 220: ©resourcedb($origcrsid,$newcrsid); 221: } 222: 223: # ===================================================== Phase one: fill-in form 224: 225: sub print_course_creation_page { 226: my $r=shift; 227: my $defdom=$ENV{'request.role.domain'}; 228: my %host_servers = &Apache::loncommon::get_library_servers($defdom); 229: my $course_home = '<select name="course_home" size="1">'."\n"; 230: foreach my $server (sort(keys(%host_servers))) { 231: $course_home .= qq{<option value="$server"}; 232: if ($server eq $Apache::lonnet::perlvar{'lonHostID'}) { 233: $course_home .= " selected "; 234: } 235: $course_home .= qq{>$server $host_servers{$server}</option>}; 236: } 237: $course_home .= "\n</select>\n"; 238: my $domform = &Apache::loncommon::select_dom_form($defdom,'ccdomain'); 239: my $bodytag=&Apache::loncommon::bodytag('Create a New Course'); 240: my $helplink=&Apache::loncommon::help_open_topic('Create_Course','Help on Creating Courses'); 241: my $cloneform=&Apache::loncommon::select_dom_form 242: ($ENV{'request.role.domain'},'clonedomain'). 243: &Apache::loncommon::selectcourse_link 244: ('ccrs','clonecourse','clonedomain'); 245: my $coursebrowserjs=&Apache::loncommon::coursebrowser_javascript(); 246: $r->print(<<ENDDOCUMENT); 247: <html> 248: <script language="JavaScript" type="text/javascript"> 249: var editbrowser = null; 250: function openbrowser(formname,elementname) { 251: var url = '/res/?'; 252: if (editbrowser == null) { 253: url += 'launch=1&'; 254: } 255: url += 'catalogmode=interactive&'; 256: url += 'mode=edit&'; 257: url += 'form=' + formname + '&'; 258: url += 'element=' + elementname + '&'; 259: url += 'only=sequence' + ''; 260: var title = 'Browser'; 261: var options = 'scrollbars=1,resizable=1,menubar=0'; 262: options += ',width=700,height=600'; 263: editbrowser = open(url,title,options,'1'); 264: editbrowser.focus(); 265: } 266: </script> 267: $coursebrowserjs 268: <head> 269: <title>The LearningOnline Network with CAPA</title> 270: </head> 271: $bodytag 272: $helplink 273: <form action="/adm/createcourse" method="post" name="ccrs"> 274: <h2>Course Information</h2> 275: <p> 276: <b>Course Title:</b> 277: <input type="text" size="50" name="title"> 278: </p><p> 279: <b>Course Home Server:</b>$course_home 280: </p><p> 281: <b>Course ID/Number (optional)</b> 282: <input type="text" size="30" name="crsid"> 283: </p> 284: <h2>Course Content</h2> 285: <table border="2"> 286: <tr><th>Completely new course</th><th>Clone an existing course</th></tr> 287: <tr><td> 288: <p> 289: <b>Map:</b> 290: <input type="text" size="50" name="topmap"> 291: <a href="javascript:openbrowser('ccrs','topmap')">Select Map</a> 292: </p><p> 293: <b>Do NOT generate as standard course</b><br /> 294: (only check if you know what you are doing): 295: <input type="checkbox" name="nonstandard"> 296: </p> 297: <p> 298: <b>First Resource</b><br />(standard courses only): 299: <input type="radio" name="firstres" value="blank">Blank 300: 301: <input type="radio" name="firstres" value="syl" checked>Syllabus 302: 303: <input type="radio" name="firstres" value="nav">Navigate 304: </p> 305: </td><td> 306: Course ID: <input input type="text" size="25" name="clonecourse" value="" /> 307: <br /> 308: Domain: 309: $cloneform<br /> <br /> 310: Additional settings, if specified below, will override cloned settings. 311: </td></tr> 312: </table> 313: <h2>Assessment Parameters</h2> 314: <p> 315: <b>Open all assessments: </b> 316: <input type="checkbox" name="openall" checked> 317: </p> 318: <h2>Messaging</h2> 319: <p> 320: <b>Set course policy feedback to Course Coordinator: </b> 321: <input type="checkbox" name="setpolicy" checked> 322: </p><p> 323: <b>Set content feedback to Course Coordinator: </b> 324: <input type="checkbox" name="setcontent" checked> 325: </p> 326: <h2>Communication</h2> 327: <p> 328: <b>Disable student resource discussion: </b> 329: <input type="checkbox" name="disresdis" /> <br /> 330: <b>Disable student use of chatrooms: </b> 331: <input type="checkbox" name="disablechat" /> 332: </p> 333: <h2>Access Control</h2> 334: <p> 335: <b>Students need access key to enter course: </b> 336: <input type="checkbox" name="setkeys" /> 337: </p> 338: <h2>Course Coordinator</h2> 339: <p> 340: <b>Username:</b> <input type="text" size="15" name="ccuname" /> 341: </p><p> 342: <b>Domain:</b> $domform 343: </p><p> 344: <b>Immediately expire own role as Course Coordinator:</b> 345: <input type="checkbox" name="expireown" checked> 346: </p><p> 347: <input type="hidden" name="phase" value="two" /> 348: <input type="submit" value="Open Course"> 349: </p> 350: </form> 351: </body> 352: </html> 353: ENDDOCUMENT 354: } 355: 356: # ====================================================== Phase two: make course 357: 358: sub create_course { 359: my $r=shift; 360: my $topurl='/res/'.&Apache::lonnet::declutter($ENV{'form.topmap'}); 361: my $ccuname=$ENV{'form.ccuname'}; 362: my $ccdomain=$ENV{'form.ccdomain'}; 363: $ccuname=~s/\W//g; 364: $ccdomain=~s/\W//g; 365: my $cdescr=$ENV{'form.title'}; 366: my $curl=$ENV{'form.topmap'}; 367: my $bodytag=&Apache::loncommon::bodytag('Create a New Course'); 368: $r->print(<<ENDENHEAD); 369: <html> 370: <head> 371: <title>The LearningOnline Network with CAPA</title> 372: </head> 373: $bodytag 374: ENDENHEAD 375: # 376: # Verify data 377: # 378: # Check the veracity of the course coordinator 379: if (&Apache::lonnet::homeserver($ccuname,$ccdomain) eq 'no_host') { 380: $r->print('No such user '.$ccuname.' at '.$ccdomain.'</body></html>'); 381: return; 382: } 383: # Check the proposed home server for the course 384: my %host_servers = &Apache::loncommon::get_library_servers 385: ($ENV{'request.role.domain'}); 386: if (! exists($host_servers{$ENV{'form.course_home'}})) { 387: $r->print('Invalid home server for course: '. 388: $ENV{'form.course_home'}.'</body></html>'); 389: return; 390: } 391: # 392: # Open course 393: # 394: my %cenv=(); 395: my $courseid=&Apache::lonnet::createcourse($ENV{'request.role.domain'}, 396: $cdescr,$curl, 397: $ENV{'form.course_home'}, 398: $ENV{'form.nonstandard'}); 399: 400: # Note: The testing routines depend on this being output; see 401: # Utils::Course. This needs to at least be output as a comment 402: # if anyone ever decides to not show this, and Utils::Course::new 403: # will need to be suitably modified. 404: $r->print('New LON-CAPA Course ID: '.$courseid.'<br>'); 405: # 406: # Check if created correctly 407: # 408: my ($crsudom,$crsunum)=($courseid=~/^\/(\w+)\/(\w+)$/); 409: my $crsuhome=&Apache::lonnet::homeserver($crsunum,$crsudom); 410: $r->print('Created on: '.$crsuhome.'<br>'); 411: # 412: # Are we cloning? 413: # 414: my $cloneid=''; 415: if (($ENV{'form.clonecourse'}) && ($ENV{'form.clonedomain'})) { 416: $cloneid='/'.$ENV{'form.clonedomain'}.'/'.$ENV{'form.clonecourse'}; 417: my ($clonecrsudom,$clonecrsunum)=($cloneid=~/^\/(\w+)\/(\w+)$/); 418: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom); 419: if ($clonehome eq 'no_host') { 420: $r->print( 421: '<br /><font color="red">Attempting to clone non-existing course '.$cloneid.'</font>'); 422: } else { 423: $r->print( 424: '<br /><font color="green">Cloning course from '.$clonehome.'</font>'); 425: my %oldcenv=&Apache::lonnet::dump('environment',$crsudom,$crsunum); 426: # Copy all files 427: ©coursefiles($cloneid,$courseid); 428: # Restore URL 429: $cenv{'url'}=$oldcenv{'url'}; 430: # Restore title 431: $cenv{'description'}=$oldcenv{'description'}; 432: # Mark as cloned 433: $cenv{'clonedfrom'}=$cloneid; 434: } 435: } 436: # 437: # Set environment (will override cloned, if existing) 438: # 439: if ($ENV{'form.crsid'}) { 440: $cenv{'courseid'}=$ENV{'form.crsid'}; 441: } 442: if (($ccdomain) && ($ccuname)) { 443: if ($ENV{'form.setpolicy'}) { 444: $cenv{'policy.email'}=$ccuname.':'.$ccdomain; 445: } 446: if ($ENV{'form.setcontent'}) { 447: $cenv{'question.email'}=$ccuname.':'.$ccdomain; 448: } 449: } 450: if ($ENV{'form.setkeys'}) { 451: $cenv{'keyaccess'}='yes'; 452: } 453: if ($ENV{'form.disresdis'}) { 454: $cenv{'pch.roles.denied'}='st'; 455: } 456: if ($ENV{'form.disablechat'}) { 457: $cenv{'plc.roles.denied'}='st'; 458: } 459: 460: # Record we've not yet viewed the Course Initialization Helper for this 461: # course 462: $cenv{'course.helper.not.run'} = 1; 463: # 464: # Use new Randomseed 465: # 466: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();; 467: # 468: # By default, use standard grading 469: $cenv{'grading'} = 'standard'; 470: 471: $r->print('<br />Setting environment: '. 472: &Apache::lonnet::put('environment',\%cenv,$crsudom,$crsunum).'<br>'); 473: # 474: # Open all assignments 475: # 476: if ($ENV{'form.openall'}) { 477: my $storeunder=$crsudom.'_'.$crsunum.'.0.opendate'; 478: my %storecontent = ($storeunder => time, 479: $storeunder.'.type' => 'date_start'); 480: 481: $r->print('Opening all assignments: '.&Apache::lonnet::cput 482: ('resourcedata',\%storecontent,$crsudom,$crsunum).'<br>'); 483: } 484: # 485: # Set first page 486: # 487: unless (($ENV{'form.nonstandard'}) || ($ENV{'form.firstres'} eq 'blank')) { 488: $r->print('Setting first resource: '); 489: my ($errtext,$fatal)= 490: &Apache::londocs::mapread($crsunum,$crsudom,'default.sequence'); 491: $r->print(($fatal?$errtext:'read ok').' - '); 492: my $title; my $url; 493: if ($ENV{'form.firstres'} eq 'syl') { 494: $title='Syllabus'; 495: $url='/public/'.$crsudom.'/'.$crsunum.'/syllabus'; 496: } else { 497: $title='Navigate Contents'; 498: $url='/adm/navmaps'; 499: } 500: $Apache::lonratedt::resources[1]=$title.':'.$url.':false:start:res'; 501: ($errtext,$fatal)= 502: &Apache::londocs::storemap($crsunum,$crsudom,'default.sequence'); 503: $r->print(($fatal?$errtext:'write ok').'<br>'); 504: } 505: # 506: # Make current user course adminstrator 507: # 508: my $end=undef; 509: my $addition=''; 510: if ($ENV{'form.expireown'}) { $end=time+5; $addition='expired'; } 511: $r->print('Assigning '.$addition.' role of course coordinator to self: '. 512: &Apache::lonnet::assignrole( 513: $ENV{'user.domain'},$ENV{'user.name'},$courseid,'cc',$end).'<br>'); 514: # 515: # Make additional user course administrator 516: # 517: if (($ccdomain) && ($ccuname)) { 518: $r->print('Assigning role of course coordinator to '. 519: $ccuname.' at '.$ccdomain.': '. 520: &Apache::lonnet::assignrole($ccdomain,$ccuname,$courseid,'cc').'<p>'); 521: } 522: if ($ENV{'form.setkeys'}) { 523: $r->print( 524: '<p><a href="/adm/managekeys?cid='.$crsudom.'_'.$crsunum.'">Manage Access Keys</a></p>'); 525: } 526: $r->print('<p>Roles will be active at next login.</p></body></html>'); 527: } 528: 529: # ===================================================================== Handler 530: sub handler { 531: my $r = shift; 532: 533: if ($r->header_only) { 534: &Apache::loncommon::content_type($r,'text/html'); 535: $r->send_http_header; 536: return OK; 537: } 538: 539: if (&Apache::lonnet::allowed('ccc',$ENV{'request.role.domain'})) { 540: &Apache::loncommon::content_type($r,'text/html'); 541: $r->send_http_header; 542: 543: if ($ENV{'form.phase'} eq 'two') { 544: &create_course($r); 545: } else { 546: &print_course_creation_page($r); 547: } 548: } else { 549: $ENV{'user.error.msg'}= 550: "/adm/createcourse:ccc:0:0:Cannot create courses"; 551: return HTTP_NOT_ACCEPTABLE; 552: } 553: return OK; 554: } 555: 556: 1; 557: __END__