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