Annotation of loncom/interface/loncreatecourse.pm, revision 1.76
1.65 raeburn 1: # The LearningOnline Network
1.1 www 2: # Create a course
1.5 albertel 3: #
1.76 ! albertel 4: # $Id: loncreatecourse.pm,v 1.75 2005/01/20 16:30:52 albertel Exp $
1.5 albertel 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: #
1.48 www 28: ###
29:
1.1 www 30: package Apache::loncreatecourse;
31:
32: use strict;
33: use Apache::Constants qw(:common :http);
34: use Apache::lonnet;
1.12 www 35: use Apache::loncommon;
1.13 www 36: use Apache::lonratedt;
37: use Apache::londocs;
1.38 www 38: use Apache::lonlocal;
1.41 raeburn 39: use Apache::londropadd;
1.44 raeburn 40: use lib '/home/httpd/lib/perl';
1.28 www 41:
42: # ================================================ Get course directory listing
43:
1.62 www 44: my @output=();
45:
1.28 www 46: sub crsdirlist {
47: my ($courseid,$which)=@_;
1.62 www 48: @output=();
49: return &innercrsdirlist($courseid,$which);
50: }
51:
52: sub innercrsdirlist {
53: my ($courseid,$which,$path)=@_;
54: my $dirptr=16384;
1.63 www 55: unless ($which) { $which=''; } else { $which.='/'; }
56: unless ($path) { $path=''; } else { $path.='/'; }
1.28 www 57: my %crsdata=&Apache::lonnet::coursedescription($courseid);
58: my @listing=&Apache::lonnet::dirlist
59: ($which,$crsdata{'domain'},$crsdata{'num'},
1.39 albertel 60: &Apache::loncommon::propath($crsdata{'domain'},$crsdata{'num'}));
1.28 www 61: foreach (@listing) {
62: unless ($_=~/^\./) {
1.62 www 63: my @unpackline = split (/\&/,$_);
64: if ($unpackline[3]&$dirptr) {
65: # is a directory, recurse
1.63 www 66: &innercrsdirlist($courseid,$which.$unpackline[0],
67: $path.$unpackline[0]);
1.62 www 68: } else {
69: # is a file, put into output
1.63 www 70: push (@output,$path.$unpackline[0]);
1.62 www 71: }
1.28 www 72: }
73: }
74: return @output;
1.29 www 75: }
76:
77: # ============================================================= Read a userfile
78:
79: sub readfile {
80: my ($courseid,$which)=@_;
81: my %crsdata=&Apache::lonnet::coursedescription($courseid);
82: return &Apache::lonnet::getfile('/uploaded/'.$crsdata{'domain'}.'/'.
83: $crsdata{'num'}.'/'.$which);
84: }
85:
86: # ============================================================ Write a userfile
87:
88: sub writefile {
1.30 www 89: (my $courseid, my $which,$ENV{'form.output'})=@_;
1.29 www 90: my %crsdata=&Apache::lonnet::coursedescription($courseid);
91: return &Apache::lonnet::finishuserfileupload(
92: $crsdata{'num'},$crsdata{'domain'},
93: $crsdata{'home'},
94: 'output',$which);
95: }
96:
1.36 www 97: # ===================================================================== Rewrite
98:
99: sub rewritefile {
100: my ($contents,%rewritehash)=@_;
101: foreach (keys %rewritehash) {
102: my $pattern=$_;
103: $pattern=~s/(\W)/\\$1/gs;
104: my $new=$rewritehash{$_};
105: $contents=~s/$pattern/$new/gs;
106: }
107: return $contents;
108: }
109:
1.29 www 110: # ============================================================= Copy a userfile
111:
112: sub copyfile {
113: my ($origcrsid,$newcrsid,$which)=@_;
1.36 www 114: unless ($which=~/\.sequence$/) {
115: return &writefile($newcrsid,$which,
116: &readfile($origcrsid,$which));
117: } else {
118: my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
119: my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
120: return &writefile($newcrsid,$which,
121: &rewritefile(
122: &readfile($origcrsid,$which),
123: (
124: '/uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
1.66 albertel 125: => '/uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/',
126: '/public/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
127: => '/public/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/'
1.36 www 128: )));
129: }
1.30 www 130: }
131:
132: # =============================================================== Copy a dbfile
133:
134: sub copydb {
135: my ($origcrsid,$newcrsid,$which)=@_;
136: $which=~s/\.db$//;
137: my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
138: my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
139: my %data=&Apache::lonnet::dump
140: ($which,$origcrsdata{'domain'},$origcrsdata{'num'});
1.72 albertel 141: foreach my $key (keys(%data)) {
142: if ($key=~/^internal./) { delete($data{$key}); }
143: }
1.30 www 144: return &Apache::lonnet::put
145: ($which,\%data,$newcrsdata{'domain'},$newcrsdata{'num'});
146: }
147:
1.35 www 148: # ========================================================== Copy resourcesdata
149:
150: sub copyresourcedb {
151: my ($origcrsid,$newcrsid)=@_;
152: my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
153: my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
154: my %data=&Apache::lonnet::dump
155: ('resourcedata',$origcrsdata{'domain'},$origcrsdata{'num'});
156: $origcrsid=~s/^\///;
157: $origcrsid=~s/\//\_/;
158: $newcrsid=~s/^\///;
159: $newcrsid=~s/\//\_/;
160: my %newdata=();
161: undef %newdata;
162: my $startdate=$data{$origcrsid.'.0.opendate'};
163: my $today=time;
164: my $delta=0;
165: if ($startdate) {
166: my $oneday=60*60*24;
167: $delta=$today-$startdate;
168: $delta=int($delta/$oneday)*$oneday;
169: }
170: # ugly retro fix for broken version of types
171: foreach (keys %data) {
172: if ($_=~/\wtype$/) {
173: my $newkey=$_;
174: $newkey=~s/type$/\.type/;
175: $data{$newkey}=$data{$_};
176: delete $data{$_};
177: }
178: }
1.37 www 179: # adjust symbs
180: my $pattern='uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/';
181: $pattern=~s/(\W)/\\$1/gs;
182: my $new= 'uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/';
183: foreach (keys %data) {
184: if ($_=~/$pattern/) {
185: my $newkey=$_;
186: $newkey=~s/$pattern/$new/;
187: $data{$newkey}=$data{$_};
188: delete $data{$_};
189: }
190: }
1.35 www 191: # adjust dates
192: foreach (keys %data) {
193: my $thiskey=$_;
194: $thiskey=~s/^$origcrsid/$newcrsid/;
195: $newdata{$thiskey}=$data{$_};
1.75 albertel 196: if ($data{$_.'.type'}=~/^date_(start|end)$/) {
1.35 www 197: $newdata{$thiskey}=$newdata{$thiskey}+$delta;
198: }
199: }
200: return &Apache::lonnet::put
201: ('resourcedata',\%newdata,$newcrsdata{'domain'},$newcrsdata{'num'});
202: }
203:
1.30 www 204: # ========================================================== Copy all userfiles
205:
206: sub copyuserfiles {
207: my ($origcrsid,$newcrsid)=@_;
208: foreach (&crsdirlist($origcrsid,'userfiles')) {
1.69 albertel 209: if ($_ !~m|^scantron_|) {
210: ©file($origcrsid,$newcrsid,$_);
211: }
1.30 www 212: }
213: }
214: # ========================================================== Copy all userfiles
215:
216: sub copydbfiles {
217: my ($origcrsid,$newcrsid)=@_;
218: foreach (&crsdirlist($origcrsid)) {
219: if ($_=~/\.db$/) {
220: unless
1.34 www 221: ($_=~/^(nohist\_|discussiontimes|classlist|versionupdate|resourcedata)/) {
1.30 www 222: ©db($origcrsid,$newcrsid,$_);
223: }
224: }
225: }
1.31 www 226: }
227:
228: # ======================================================= Copy all course files
229:
230: sub copycoursefiles {
231: my ($origcrsid,$newcrsid)=@_;
232: ©userfiles($origcrsid,$newcrsid);
233: ©dbfiles($origcrsid,$newcrsid);
1.35 www 234: ©resourcedb($origcrsid,$newcrsid);
1.28 www 235: }
1.13 www 236:
1.2 www 237: # ===================================================== Phase one: fill-in form
238:
1.10 matthew 239: sub print_course_creation_page {
1.2 www 240: my $r=shift;
1.10 matthew 241: my $defdom=$ENV{'request.role.domain'};
242: my %host_servers = &Apache::loncommon::get_library_servers($defdom);
243: my $course_home = '<select name="course_home" size="1">'."\n";
244: foreach my $server (sort(keys(%host_servers))) {
1.14 matthew 245: $course_home .= qq{<option value="$server"};
246: if ($server eq $Apache::lonnet::perlvar{'lonHostID'}) {
247: $course_home .= " selected ";
248: }
249: $course_home .= qq{>$server $host_servers{$server}</option>};
1.10 matthew 250: }
251: $course_home .= "\n</select>\n";
1.9 matthew 252: my $domform = &Apache::loncommon::select_dom_form($defdom,'ccdomain');
1.12 www 253: my $bodytag=&Apache::loncommon::bodytag('Create a New Course');
1.46 sakharuk 254: my $helplink=&Apache::loncommon::help_open_topic('Create_Course',&mt('Help on Creating Courses'));
1.32 www 255: my $cloneform=&Apache::loncommon::select_dom_form
256: ($ENV{'request.role.domain'},'clonedomain').
257: &Apache::loncommon::selectcourse_link
258: ('ccrs','clonecourse','clonedomain');
1.70 raeburn 259: my $coursebrowserjs=&Apache::loncommon::coursebrowser_javascript($ENV{'request.role.domain'});
1.43 raeburn 260: my $starttime = time;
261: my $endtime = time+(6*30*24*60*60); # 6 months from now, approx
1.60 raeburn 262: my $enroll_table = &Apache::londropadd::date_setting_table($starttime,$endtime,'create_enrolldates');
263: my $access_table = &Apache::londropadd::date_setting_table($starttime,$endtime,'create_defaultdates');
1.40 raeburn 264: my ($krbdef,$krbdefdom) =
265: &Apache::loncommon::get_kerberos_defaults($defdom);
1.41 raeburn 266: my $javascript_validations=&Apache::londropadd::javascript_validations('createcourse',$krbdefdom);
1.40 raeburn 267: my %param = ( formname => 'document.ccrs',
268: kerb_def_dom => $krbdefdom,
269: kerb_def_auth => $krbdef
270: );
271: my $krbform = &Apache::loncommon::authform_kerberos(%param);
272: my $intform = &Apache::loncommon::authform_internal(%param);
273: my $locform = &Apache::loncommon::authform_local(%param);
1.46 sakharuk 274: my %lt=&Apache::lonlocal::texthash(
275: 'cinf' => "Course Information",
276: 'ctit' => "Course Title",
277: 'chsr' => "Course Home Server",
278: 'cidn' => "Course ID/Number",
279: 'opt' => "optional",
280: 'iinf' => "Institutional Information",
281: 'stat' => "The following entries will be used to identify the course according to the naming scheme adopted by your institution. Your choices will be used to map an internal LON-CAPA course ID to the corresponding course section ID(s) used by the office responsible for providing official class lists for courses at your institution. This mapping is required if you choose to employ automatic population of class lists.",
282: 'ccod' => "Course Code",
283: 'toin' => "to interface with institutional data, e.g., fs03glg231 for Fall 2003 Geology 231",
284: 'snid' => "Section Numbers and corresponding LON-CAPA section/group IDs",
285: 'csli' => "a comma separated list of institutional section numbers, each separated by a colon from the (optional) corresponding section/group ID to be used in LON-CAPA e.g., 001:1,002:2",
286: 'crcs' => "Crosslisted courses",
1.65 raeburn 287: 'cscs' => "a comma separated list of course sections crosslisted with the current course, with each entry including the institutional course section name followed by a colon and then the (optional) groupID to be used in LON-CAPA, e.g., fs03ent231001:ent1,fs03bot231001:bot1,fs03zol231002:zol2",
1.46 sakharuk 288: 'crco' => "Course Content",
289: 'cncr' => "Completely new course",
290: 'cecr' => "Clone an existing course",
291: 'map' => "Map",
292: 'smap' => "Select Map",
293: 'sacr' => "Do NOT generate as standard course",
294: 'ocik' => "only check if you know what you are doing",
295: 'fres' => "First Resource",
296: 'stco' => "standard courses only",
297: 'blnk' => "Blank",
298: 'sllb' => "Syllabus",
299: 'navi' => "Navigate",
300: 'cid' => "Course ID",
301: 'dmn' => "Domain",
302: 'asov' => "Additional settings, if specified below, will override cloned settings",
303: 'assp' => "Assessment Parameters",
304: 'oaas' => "Open all assessments",
305: 'mssg' => "Messaging",
306: 'scpf' => "Set course policy feedback to Course Coordinator",
307: 'scfc' => "Set content feedback to Course Coordinator",
308: 'cmmn' => "Communication",
309: 'dsrd' => "Disable student resource discussion",
310: 'dsuc' => "Disable student use of chatrooms",
311: 'acco' => "Access Control",
312: 'snak' => "Students need access key to enter course",
1.56 www 313: 'kaut' =>
314: 'Key authority (<tt>id@domain</tt>) if other than course',
1.46 sakharuk 315: 'cc' => "Course Coordinator",
316: 'user' => "Username",
317: 'ierc' => "Immediately expire own role as Course Coordinator",
318: 'aens' => "Automated enrollment settings",
319: 'aesc' => "The following settings control automatic enrollment of students in this class based on information available for this specific course from your institution's official classlists.",
320: 'aadd' => "Automated adds",
321: 'yes' => "Yes",
322: 'no' => "No",
323: 'audr' => "Automated drops",
324: 'dacu' => "Duration of automated classlist updates",
1.60 raeburn 325: 'dacc' => "Default start and end dates for student access",
1.46 sakharuk 326: 'psam' => "Please select the authentication mechanism",
327: 'pcda' => "Please choose the default authentication method to be used by new users added to this LON-CAPA domain by the automated enrollment process",
328: 'nech' => "Notification of enrollment changes",
329: 'nccl' => "Notification to course coordinator via LON-CAPA message when enrollment changes occur during the automated update?",
330: 'irsp' => "Include retrieval of student photographs?",
1.55 www 331: 'rshm' => 'Resource Space Home',
1.46 sakharuk 332: 'opco' => "Open Course"
333: );
1.76 ! albertel 334: my $html=&Apache::lonxml::xmlbegin();
1.2 www 335: $r->print(<<ENDDOCUMENT);
1.76 ! albertel 336: $html
! 337: <head>
1.6 matthew 338: <script language="JavaScript" type="text/javascript">
339: var editbrowser = null;
340: function openbrowser(formname,elementname) {
341: var url = '/res/?';
342: if (editbrowser == null) {
343: url += 'launch=1&';
344: }
345: url += 'catalogmode=interactive&';
346: url += 'mode=edit&';
347: url += 'form=' + formname + '&';
1.7 matthew 348: url += 'element=' + elementname + '&';
349: url += 'only=sequence' + '';
1.6 matthew 350: var title = 'Browser';
351: var options = 'scrollbars=1,resizable=1,menubar=0';
352: options += ',width=700,height=600';
353: editbrowser = open(url,title,options,'1');
354: editbrowser.focus();
355: }
1.41 raeburn 356: $javascript_validations
1.6 matthew 357: </script>
1.32 www 358: $coursebrowserjs
1.2 www 359: <title>The LearningOnline Network with CAPA</title>
360: </head>
1.12 www 361: $bodytag
1.17 www 362: $helplink
1.6 matthew 363: <form action="/adm/createcourse" method="post" name="ccrs">
1.46 sakharuk 364: <h2>$lt{'cinf'}</h2>
1.10 matthew 365: <p>
1.68 matthew 366: <label><b>$lt{'ctit'}:</b>
367: <input type="text" size="50" name="title" /></label>
1.10 matthew 368: </p><p>
1.68 matthew 369: <label>
370: <b>$lt{'chsr'}:</b>$course_home
371: </label>
372: </p><p>
373: <label>
374: <b>$lt{'cidn'} ($lt{'opt'})</b>
375: <input type="text" size="30" name="crsid" />
376: </label>
1.40 raeburn 377: </p><p>
1.46 sakharuk 378: <h2>$lt{'iinf'}</h2>
1.40 raeburn 379: <p>
1.46 sakharuk 380: $lt{'stat'}
1.40 raeburn 381: </p><p>
1.68 matthew 382: <label>
383: <b>$lt{'ccod'}</b>
384: <input type="text" size="30" name="crscode" />
385: </label>
386: <br/>
1.46 sakharuk 387: ($lt{'toin'})
1.40 raeburn 388: </p><p>
1.68 matthew 389: <label>
390: <b>$lt{'snid'}</b>
391: <input type="text" size="30" name="crssections" />
392: </label>
393: <br/>
1.46 sakharuk 394: ($lt{'csli'})
1.40 raeburn 395: </p><p>
1.68 matthew 396: <label>
397: <b>$lt{'crcs'}</b>
398: <input type="text" size="30" name="crsxlist" />
399: </label>
400: <br/>
1.46 sakharuk 401: ($lt{'cscs'})
1.13 www 402: </p>
1.46 sakharuk 403: <h2>$lt{'crco'}</h2>
1.32 www 404: <table border="2">
1.46 sakharuk 405: <tr><th>$lt{'cncr'}</th><th>$lt{'cecr'}</th></tr>
1.32 www 406: <tr><td>
1.13 www 407: <p>
1.68 matthew 408: <label>
409: <b>$lt{'map'}:</b>
410: <input type="text" size="50" name="topmap" />
411: </label>
1.46 sakharuk 412: <a href="javascript:openbrowser('ccrs','topmap')">$lt{'smap'}</a>
1.10 matthew 413: </p><p>
1.68 matthew 414: <label for="nonstd"><b>$lt{'sacr'}</b></label>
415: <br />
1.46 sakharuk 416: ($lt{'ocik'}):
1.68 matthew 417: <input id="nonstd" type="checkbox" name="nonstandard" />
418: </p><p>
1.46 sakharuk 419: <b>$lt{'fres'}</b><br />($lt{'stco'}):
1.68 matthew 420: <label>
421: <input type="radio" name="firstres" value="blank" />$lt{'blnk'}
422: </label>
1.13 www 423:
1.68 matthew 424: <label>
425: <input type="radio" name="firstres" value="syl" checked />$lt{'sllb'}
426: </label>
1.13 www 427:
1.68 matthew 428: <label>
429: <input type="radio" name="firstres" value="nav" />$lt{'navi'}
430: </label>
1.13 www 431: </p>
1.32 www 432: </td><td>
1.68 matthew 433: <label>
434: $lt{'cid'}: <input type="text" size="25" name="clonecourse" value="" />
435: </label>
436: <br />
437: <label>
438: $lt{'dmn'}: $cloneform
439: </label>
1.32 www 440: <br />
1.68 matthew 441: <br />
1.46 sakharuk 442: $lt{'asov'}.
1.32 www 443: </td></tr>
444: </table>
1.46 sakharuk 445: <h2>$lt{'assp'}</h2>
1.13 www 446: <p>
1.68 matthew 447: <label>
448: <b>$lt{'oaas'}: </b>
449: <input type="checkbox" name="openall" />
450: </label>
1.13 www 451: </p>
1.46 sakharuk 452: <h2>$lt{'mssg'}</h2>
1.13 www 453: <p>
1.68 matthew 454: <label>
455: <b>$lt{'scpf'}: </b>
456: <input type="checkbox" name="setpolicy" checked />
457: </label>
1.55 www 458: <br />
1.68 matthew 459: <label>
460: <b>$lt{'scfc'}: </b>
461: <input type="checkbox" name="setcontent" checked />
462: </label>
1.11 www 463: </p>
1.46 sakharuk 464: <h2>$lt{'cmmn'}</h2>
1.16 www 465: <p>
1.68 matthew 466: <label>
467: <b>$lt{'dsrd'}: </b>
468: <input type="checkbox" name="disresdis" />
469: </label>
470: <br />
471: <label>
472: <b>$lt{'dsuc'}: </b>
473: <input type="checkbox" name="disablechat" />
474: </label>
1.16 www 475: </p>
1.46 sakharuk 476: <h2>$lt{'acco'}</h2>
1.18 www 477: <p>
1.68 matthew 478: <label>
479: <b>$lt{'snak'}: </b>
480: <input type="checkbox" name="setkeys" />
481: </label>
482: <br />
483: <label>
484: <b>$lt{'kaut'}: </b>
485: <input type="text" size="30" name="keyauth" />
486: </label>
1.18 www 487: </p>
1.55 www 488: <h2>$lt{'rshm'}</h2>
489: <p>
1.68 matthew 490: <label>
491: <b>$lt{'rshm'}: </b>
492: <input type="text" name="reshome" size="30" value="/res/$defdom/" />
493: </label>
1.55 www 494: </p>
1.10 matthew 495: <p>
1.46 sakharuk 496: <h2>$lt{'aens'}</h2>
497: $lt{'aesc'}
1.40 raeburn 498: </p>
499: <p>
1.46 sakharuk 500: <b>$lt{'aadd'}</b>
1.68 matthew 501: <label><input type="radio" name="autoadds" value="1" />$lt{'yes'}</label>
502: <label><input type="radio" name="autoadds" value="0" checked="true" />$lt{'no'}
503: </label>
1.40 raeburn 504: </p><p>
1.46 sakharuk 505: <b>$lt{'audr'}</b>
1.68 matthew 506: <label><input type="radio" name="autodrops" value="1" />$lt{'yes'}</label>
507: <label><input type="radio" name="autodrops" value="0" checked="true" />$lt{'no'}</label>
1.40 raeburn 508: </p><p>
1.46 sakharuk 509: <b>$lt{'dacu'}</b>
1.60 raeburn 510: $enroll_table
1.40 raeburn 511: </p><p>
1.60 raeburn 512: <b>$lt{'dacc'}</b>
513: $access_table
514: <p></p>
1.46 sakharuk 515: <b>$lt{'psam'}.</b><br />
516: $lt{'pcda'}.
1.40 raeburn 517: </p><p>
518: $krbform
519: <br />
520: $intform
521: <br />
522: $locform
523: </p><p>
1.46 sakharuk 524: <b>$lt{'nech'}</b><br />
525: $lt{'nccl'}<br/>
1.68 matthew 526: <label>
527: <input type="radio" name="notify" value="1" />$lt{'yes'}
528: </label>
529: <label>
530: <input type="radio" name="notify" value="0" checked="true" />$lt{'no'}
531: </label>
532: </p><p>
533: <b>$lt{'irsp'}</b>
534: <label>
535: <input type="radio" name="showphotos" value="1" />$lt{'yes'}
536: </label>
537: <label>
538: <input type="radio" name="showphotos" value="0" checked="true" />$lt{'no'}
539: </label>
1.55 www 540: </p>
541: <hr />
542: <h2>$lt{'cc'}</h2>
543: <p>
1.68 matthew 544: <label>
545: <b>$lt{'user'}:</b> <input type="text" size="15" name="ccuname" />
546: </label>
547: </p><p>
548: <label>
549: <b>$lt{'dmn'}:</b> $domform
550: </label>
551: </p><p>
552: <label>
553: <b>$lt{'ierc'}:</b>
554: <input type="checkbox" name="expireown" checked />
555: </label>
1.55 www 556: </p>
557: <p>
1.10 matthew 558: <input type="hidden" name="phase" value="two" />
1.68 matthew 559: <input type="button" onClick="verify_message(this.form)" value="$lt{'opco'}" />
1.10 matthew 560: </p>
1.2 www 561: </form>
562: </body>
563: </html>
564: ENDDOCUMENT
1.40 raeburn 565: }
566:
1.2 www 567: # ====================================================== Phase two: make course
568:
1.10 matthew 569: sub create_course {
1.2 www 570: my $r=shift;
571: my $ccuname=$ENV{'form.ccuname'};
572: my $ccdomain=$ENV{'form.ccdomain'};
573: $ccuname=~s/\W//g;
574: $ccdomain=~s/\W//g;
1.74 raeburn 575:
576: my $enrollstart = &Apache::lonhtmlcommon::get_date_from_form('startenroll');
577: my $enrollend = &Apache::lonhtmlcommon::get_date_from_form('endenroll');
578: my $startaccess = &Apache::lonhtmlcommon::get_date_from_form('startaccess');
579: my $endaccess = &Apache::lonhtmlcommon::get_date_from_form('endaccess');
580:
581: my $autharg;
582: my $authtype;
583:
584: if ($ENV{'form.login'} eq 'krb') {
585: $authtype = 'krb';
586: $authtype .=$ENV{'form.krbver'};
587: $autharg = $ENV{'form.krbarg'};
588: } elsif ($ENV{'form.login'} eq 'int') {
589: $authtype ='internal';
590: if ((defined($ENV{'form.intarg'})) && ($ENV{'form.intarg'})) {
591: $autharg = $ENV{'form.intarg'};
592: }
593: } elsif ($ENV{'form.login'} eq 'loc') {
594: $authtype = 'localauth';
595: if ((defined($ENV{'form.locarg'})) && ($ENV{'form.locarg'})) {
596: $autharg = $ENV{'form.locarg'};
597: }
598: }
599:
600: my $logmsg;
1.76 ! albertel 601: my $html=&Apache::lonxml::xmlbegin();
1.12 www 602: my $bodytag=&Apache::loncommon::bodytag('Create a New Course');
1.2 www 603: $r->print(<<ENDENHEAD);
1.76 ! albertel 604: $html
1.2 www 605: <head>
606: <title>The LearningOnline Network with CAPA</title>
607: </head>
1.12 www 608: $bodytag
1.2 www 609: ENDENHEAD
1.74 raeburn 610:
611: my $args = {
612: ccuname => $ccuname,
613: ccdomain => $ccdomain,
614: cdescr => $ENV{'form.title'},
615: curl => $ENV{'form.topmap'},
616: course_domain => $ENV{'request.role.domain'},
617: course_home => $ENV{'form.course_home'},
618: nonstandard => $ENV{'form.nonstandard'},
619: crscode => $ENV{'form.crscode'},
620: clonecourse => $ENV{'form.clonecourse'},
621: clonedomain => $ENV{'form.clonedomain'},
622: crsid => $ENV{'form.crsid'},
623: curruser => $ENV{'user.name'},
624: crssections => $ENV{'form.crssections'},
625: crsxlist => $ENV{'form.crsxlist'},
626: autoadds => $ENV{'form.autoadds'},
627: autodrops => $ENV{'form.autodrops'},
628: notify => $ENV{'form.notify'},
629: no_end_date => $ENV{'form.no_end_date'},
630: showphotos => $ENV{'form.showphotos'},
631: authtype => $authtype,
632: autharg => $autharg,
633: enrollstart => $enrollstart,
634: enrollend => $enrollend,
635: startaccess => $startaccess,
636: endaccess => $endaccess,
637: setpolicy => $ENV{'form.setpolicy'},
638: setcontent => $ENV{'form.setcontent'},
639: reshome => $ENV{'form.reshome'},
640: setkeys => $ENV{'form.setkeys'},
641: keyauth => $ENV{'form.keyauth'},
642: disresdis => $ENV{'form.disresdis'},
643: disablechat => $ENV{'form.disablechat'},
644: openall => $ENV{'form.openall'},
645: firstres => $ENV{'form.firstres'}
646: };
647:
1.10 matthew 648: #
649: # Verify data
650: #
651: # Check the veracity of the course coordinator
1.2 www 652: if (&Apache::lonnet::homeserver($ccuname,$ccdomain) eq 'no_host') {
1.52 albertel 653: $r->print('<form action="/adm/createuser" method="post" name="crtuser">');
654: $r->print(&mt('No such user').' '.$ccuname.' '.&mt('at').' '.$ccdomain.'.<br />');
655: $r->print(&mt("Please click Back on your browser and select another user, or "));
656: $r->print('
657: <input type="hidden" name="phase" value="get_user_info" />
658: <input type="hidden" name="ccuname" value="'.$ccuname.'" />
659: <input type="hidden" name="ccdomain" value="'.$ccdomain.'" />
660: <input name="userrole" type="submit" value="'.
661: &mt('Create User').'" />
662: </form></body></html>');
1.2 www 663: return;
664: }
1.10 matthew 665: # Check the proposed home server for the course
666: my %host_servers = &Apache::loncommon::get_library_servers
667: ($ENV{'request.role.domain'});
668: if (! exists($host_servers{$ENV{'form.course_home'}})) {
1.46 sakharuk 669: $r->print(&mt('Invalid home server for course').': '.
1.10 matthew 670: $ENV{'form.course_home'}.'</body></html>');
671: return;
672: }
1.74 raeburn 673: my ($courseid,$crsudom,$crsunum);
674: $r->print(&construct_course($args,\$logmsg,\$courseid,\$crsudom,\$crsunum));
675:
676: #
677: # Make current user course adminstrator
678: #
679: my $end=undef;
680: my $addition='';
681: if ($ENV{'form.expireown'}) { $end=time+5; $addition='expired'; }
682: $r->print(&mt('Assigning').' '.$addition.' '.&mt('role of course coordinator to self').': '.
683: &Apache::lonnet::assignrole(
684: $ENV{'user.domain'},$ENV{'user.name'},$courseid,'cc',$end).'<br>');
685: #
686: # Make additional user course administrator
687: #
688: if (($ccdomain) && ($ccuname)) {
689: $r->print(&mt('Assigning role of course coordinator to').' '.
690: $ccuname.' at '.$ccdomain.': '.
691: &Apache::lonnet::assignrole($ccdomain,$ccuname,$courseid,'cc').'<p>');
692: }
693: if ($ENV{'form.setkeys'}) {
694: $r->print(
695: '<p><a href="/adm/managekeys?cid='.$crsudom.'_'.$crsunum.'">'.&mt('Manage Access Keys').'</a></p>');
696: }
697: # Flush the course logs so reverse user roles immediately updated
698: &Apache::lonnet::flushcourselogs();
699: $r->print('<p>'.&mt('Roles will be active at next login').'.</p></body></html>');
700: }
701:
702: sub construct_course {
703: my ($args,$logmsg,$courseid,$crsudom,$crsunum) = @_;
704: my $outcome;
705:
1.2 www 706: #
707: # Open course
708: #
1.32 www 709: my %cenv=();
1.74 raeburn 710: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
711: $args->{'cdescr'},
712: $args->{'curl'},
713: $args->{'course_home'},
714: $args->{'nonstandard'},
715: $args->{'crscode'},
716: $args->{'ccuname'});
1.2 www 717:
1.27 bowersj2 718: # Note: The testing routines depend on this being output; see
719: # Utils::Course. This needs to at least be output as a comment
720: # if anyone ever decides to not show this, and Utils::Course::new
721: # will need to be suitably modified.
1.74 raeburn 722: $outcome .= 'New LON-CAPA Course ID: '.$$courseid.'<br>';
1.4 www 723: #
1.12 www 724: # Check if created correctly
1.4 www 725: #
1.74 raeburn 726: ($$crsudom,$$crsunum)=($$courseid=~/^\/(\w+)\/(\w+)$/);
727: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
728: $outcome .= &mt('Created on').': '.$crsuhome.'<br>';
1.12 www 729: #
1.32 www 730: # Are we cloning?
731: #
732: my $cloneid='';
1.74 raeburn 733: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
734: $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
1.32 www 735: my ($clonecrsudom,$clonecrsunum)=($cloneid=~/^\/(\w+)\/(\w+)$/);
736: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
737: if ($clonehome eq 'no_host') {
1.74 raeburn 738: $outcome .=
739: '<br /><font color="red">'.&mt('Attempting to clone non-existing course').' '.$cloneid.'</font>';
1.32 www 740: } else {
1.74 raeburn 741: $outcome .=
742: '<br /><font color="green">'.&mt('Cloning course from').' '.$clonehome.'</font>';
743: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.32 www 744: # Copy all files
1.74 raeburn 745: ©coursefiles($cloneid,$$courseid);
1.37 www 746: # Restore URL
747: $cenv{'url'}=$oldcenv{'url'};
1.32 www 748: # Restore title
1.37 www 749: $cenv{'description'}=$oldcenv{'description'};
1.67 albertel 750: # restore grading mode
751: if (defined($oldcenv{'grading'})) {
752: $cenv{'grading'}=$oldcenv{'grading'};
753: }
1.37 www 754: # Mark as cloned
1.35 www 755: $cenv{'clonedfrom'}=$cloneid;
1.54 albertel 756: delete($cenv{'default_enrollment_start_date'});
757: delete($cenv{'default_enrollment_end_date'});
1.32 www 758: }
759: }
760: #
761: # Set environment (will override cloned, if existing)
1.12 www 762: #
1.64 raeburn 763: my @sections = ();
764: my @xlists = ();
1.74 raeburn 765: if ($args->{'crsid'}) {
766: $cenv{'courseid'}=$args->{'crsid'};
1.40 raeburn 767: }
1.74 raeburn 768: if ($args->{'crscode'}) {
769: $cenv{'internal.coursecode'}=$args->{'crscode'};
1.40 raeburn 770: }
1.74 raeburn 771: if ($args->{'ccuname'}) {
772: $cenv{'internal.courseowner'} = $args->{'ccuname'};
1.64 raeburn 773: } else {
1.74 raeburn 774: $cenv{'internal.courseowner'} = $args->{'curruser'};
1.64 raeburn 775: }
776:
777: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
1.74 raeburn 778: if ($args->{'crssections'}) {
1.64 raeburn 779: $cenv{'internal.sectionnums'} = '';
1.74 raeburn 780: if ($args->{'crssections'} =~ m/,/) {
781: @sections = split/,/,$args->{'crssections'};
1.44 raeburn 782: } else {
1.74 raeburn 783: $sections[0] = $args->{'crssections'};
1.44 raeburn 784: }
785: if (@sections > 0) {
1.64 raeburn 786: foreach my $item (@sections) {
787: my ($sec,$gp) = split/:/,$item;
1.74 raeburn 788: my $class = $args->{'crscode'}.$sec;
1.64 raeburn 789: my $addcheck = &Apache::lonnet::auto_new_course($crsunum,$crsudom,$class,$cenv{'internal.courseowner'});
1.73 raeburn 790: $cenv{'internal.sectionnums'} .= $item.',';
791: unless ($addcheck eq 'ok') {
1.64 raeburn 792: push @badclasses, $class;
793: }
1.44 raeburn 794: }
1.64 raeburn 795: $cenv{'internal.sectionnums'} =~ s/,$//;
1.44 raeburn 796: }
1.40 raeburn 797: }
1.49 www 798: # do not hide course coordinator from staff listing,
799: # even if privileged
1.74 raeburn 800: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
801: # add crosslistings
802: if ($args->{'crsxlist'}) {
1.64 raeburn 803: $cenv{'internal.crosslistings'}='';
1.74 raeburn 804: if ($args->{'crsxlist'} =~ m/,/) {
805: @xlists = split/,/,$args->{'crsxlist'};
1.44 raeburn 806: } else {
1.74 raeburn 807: $xlists[0] = $args->{'crsxlist'};
1.44 raeburn 808: }
809: if (@xlists > 0) {
1.64 raeburn 810: foreach my $item (@xlists) {
811: my ($xl,$gp) = split/:/,$item;
1.74 raeburn 812: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
1.73 raeburn 813: $cenv{'internal.crosslistings'} .= $item.',';
814: unless ($addcheck eq 'ok') {
1.64 raeburn 815: push @badclasses, $xl;
816: }
1.44 raeburn 817: }
1.64 raeburn 818: $cenv{'internal.crosslistings'} =~ s/,$//;
1.44 raeburn 819: }
1.40 raeburn 820: }
1.74 raeburn 821: if ($args->{'autoadds'}) {
822: $cenv{'internal.autoadds'}=$args->{'autoadds'};
1.40 raeburn 823: }
1.74 raeburn 824: if ($args->{'autodrops'}) {
825: $cenv{'internal.autodrops'}=$args->{'autodrops'};
1.40 raeburn 826: }
1.74 raeburn 827: if ($args->{'notify'}) {
828: if ($args->{'ccuname'}) {
829: $cenv{'internal.notifylist'} = $args->{'ccuname'}.'@'.$args->{'ccdomain'};
1.40 raeburn 830: }
831: }
1.64 raeburn 832: if (@badclasses > 0) {
833: my %lt=&Apache::lonlocal::texthash(
1.73 raeburn 834: 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course. However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course',
1.64 raeburn 835: 'dnhr' => 'does not have rights to access enrollment in these classes',
836: 'adby' => 'as determined by the policies of your institution on access to official classlists'
837: );
1.74 raeburn 838: $outcome .= '<font color="red">'.$lt{'tclb'}.' ('.$cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.' ('.$lt{'adby'}.').<br /><ul>'."\n";
1.64 raeburn 839: foreach (@badclasses) {
1.74 raeburn 840: $outcome .= "<li>$_</li>\n";
1.44 raeburn 841: }
1.74 raeburn 842: $outcome .= "</ul><br /><br /></font>\n";
1.40 raeburn 843: }
1.74 raeburn 844: if ($args->{'no_end_date'}) {
845: $args->{'endaccess'} = 0;
1.40 raeburn 846: }
1.74 raeburn 847: $cenv{'internal.autostart'}=$args->{'enrollstart'};
848: $cenv{'internal.autoend'}=$args->{'enrollend'};
849: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
850: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
851: if ($args->{'showphotos'}) {
852: $cenv{'internal.showphotos'}=$args->{'showphotos'};
1.40 raeburn 853: }
1.74 raeburn 854: $cenv{'internal.authtype'} = $args->{'authtype'};
855: $cenv{'internal.autharg'} = $args->{'autharg'};
1.40 raeburn 856: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
857: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.74 raeburn 858: $outcome .= '<font color="red" size="+1">'.
859: &mt('As you did not include the default Kerberos domain to be used for authentication in this class, the institutional data used by the automated enrollment process must include the Kerberos domain for each new student').'</font></p>';
1.40 raeburn 860: }
1.12 www 861: }
1.74 raeburn 862: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
863: if ($args->{'setpolicy'}) {
864: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.12 www 865: }
1.74 raeburn 866: if ($args->{'setcontent'}) {
867: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.18 www 868: }
1.55 www 869: }
1.74 raeburn 870: if ($args->{'reshome'}) {
871: $cenv{'reshome'}=$args->{'reshome'}.'/';
1.55 www 872: $cenv{'reshome'}=~s/\/+$/\//;
1.18 www 873: }
1.56 www 874: #
875: # course has keyed access
876: #
1.74 raeburn 877: if ($args->{'setkeys'}) {
1.18 www 878: $cenv{'keyaccess'}='yes';
1.16 www 879: }
1.56 www 880: # if specified, key authority is not course, but user
881: # only active if keyaccess is yes
1.74 raeburn 882: if ($args->{'keyauth'}) {
883: $args->{'keyauth'}=~s/[^\w\@]//g;
884: if ($args->{'keyauth'}) {
885: $cenv{'keyauth'}=$args->{'keyauth'};
1.56 www 886: }
887: }
888:
1.74 raeburn 889: if ($args->{'disresdis'}) {
1.16 www 890: $cenv{'pch.roles.denied'}='st';
1.26 matthew 891: }
1.74 raeburn 892: if ($args->{'disablechat'}) {
1.26 matthew 893: $cenv{'plc.roles.denied'}='st';
1.21 albertel 894: }
1.23 bowersj2 895:
1.32 www 896: # Record we've not yet viewed the Course Initialization Helper for this
897: # course
1.23 bowersj2 898: $cenv{'course.helper.not.run'} = 1;
1.21 albertel 899: #
900: # Use new Randomseed
901: #
1.22 albertel 902: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
1.51 albertel 903: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
1.53 www 904: #
905: # The encryption code and receipt prefix for this course
906: #
907: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
908: $cenv{'internal.encpref'}=100+int(9*rand(99));
1.25 matthew 909: #
910: # By default, use standard grading
1.67 albertel 911: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
1.22 albertel 912:
1.74 raeburn 913: $outcome .= ('<br />'.&mt('Setting environment').': '.
914: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).'<br>');
1.12 www 915: #
916: # Open all assignments
917: #
1.74 raeburn 918: if ($args->{'openall'}) {
919: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
1.33 www 920: my %storecontent = ($storeunder => time,
921: $storeunder.'.type' => 'date_start');
1.12 www 922:
1.74 raeburn 923: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
924: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).'<br>';
1.12 www 925: }
1.13 www 926: #
927: # Set first page
928: #
1.74 raeburn 929: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
1.48 www 930: || ($cloneid)) {
1.74 raeburn 931: $outcome .= &mt('Setting first resource').': ';
1.13 www 932: my ($errtext,$fatal)=
1.74 raeburn 933: &Apache::londocs::mapread($$crsunum,$$crsudom,'default.sequence');
934: $outcome .= ($fatal?$errtext:'read ok').' - ';
1.13 www 935: my $title; my $url;
1.74 raeburn 936: if ($args->{'firstres'} eq 'syl') {
1.13 www 937: $title='Syllabus';
1.74 raeburn 938: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
1.13 www 939: } else {
940: $title='Navigate Contents';
941: $url='/adm/navmaps';
942: }
943: $Apache::lonratedt::resources[1]=$title.':'.$url.':false:start:res';
1.15 albertel 944: ($errtext,$fatal)=
1.74 raeburn 945: &Apache::londocs::storemap($$crsunum,$$crsudom,'default.sequence');
946: $outcome .= ($fatal?$errtext:'write ok').'<br>';
1.20 www 947: }
1.74 raeburn 948: return $outcome;
1.2 www 949: }
950:
951: # ===================================================================== Handler
1.1 www 952: sub handler {
953: my $r = shift;
954:
955: if ($r->header_only) {
1.38 www 956: &Apache::loncommon::content_type($r,'text/html');
1.1 www 957: $r->send_http_header;
958: return OK;
959: }
960:
1.10 matthew 961: if (&Apache::lonnet::allowed('ccc',$ENV{'request.role.domain'})) {
1.38 www 962: &Apache::loncommon::content_type($r,'text/html');
1.1 www 963: $r->send_http_header;
964:
1.2 www 965: if ($ENV{'form.phase'} eq 'two') {
1.10 matthew 966: &create_course($r);
1.2 www 967: } else {
1.10 matthew 968: &print_course_creation_page($r);
1.2 www 969: }
1.1 www 970: } else {
971: $ENV{'user.error.msg'}=
972: "/adm/createcourse:ccc:0:0:Cannot create courses";
973: return HTTP_NOT_ACCEPTABLE;
974: }
975: return OK;
976: }
977:
978: 1;
979: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to loncreatecourse.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface