File:
[LON-CAPA] /
loncom /
automation /
Autocreate.pl
Revision
1.12:
download - view:
text,
annotated -
select for diffs
Mon Feb 22 03:44:21 2010 UTC (14 years, 4 months ago) by
raeburn
Branches:
MAIN
CVS tags:
HEAD
- Extend Autocreate.pl so it can be called without command line arguments
(e.g., via a cron entry), with behavior controlled by Domain Configuration.
- No change from pre-2.9 behavior when called with command line arguments
(original implementation): /home/httpd/perl/Autocreate.pl $dom $uname:$udom
- New routines:
- &process_xml() to create courses defined in XML files in
/home/httpd/perl/tmp/addcourse/$dom/auto/pending/
- &process_official_reqs() to create official courses for which requestor
is validated as instructor or record - queued (awaiting validation)
in /home/httpd/lonUsers/$dom/$1/$2/$3/$dom-domainconfig/courserequestqueue.db.
1: #!/usr/bin/perl
2: #
3: # Automated Course Creation script
4: #
5: # $Id: Autocreate.pl,v 1.12 2010/02/22 03:44:21 raeburn Exp $
6: #
7: # Copyright Michigan State University Board of Trustees
8: #
9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
10: #
11: # LON-CAPA is free software; you can redistribute it and/or modify
12: # it under the terms of the GNU General Public License as published by
13: # the Free Software Foundation; either version 2 of the License, or
14: # (at your option) any later version.
15: #
16: # LON-CAPA is distributed in the hope that it will be useful,
17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19: # GNU General Public License for more details.
20: #
21: # You should have received a copy of the GNU General Public License
22: # along with LON-CAPA; if not, write to the Free Software
23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
24: #
25: # /home/httpd/html/adm/gpl.txt
26: #
27: # http://www.lon-capa.org/
28: #
29: # Run as www. Called from an entry in /etc/cron.d/loncapa
30: # either with command line args:
31: #
32: # www /home/httpd/perl/Autocreate.pl $dom $uname:$udom
33: #
34: # where $dom is the name of the course domain, $uname and $udom are the
35: # username and domain of a Domain Coordinator in the domain.
36: #
37: # or without args (default) controlled by domain configuration settings:
38: #
39: # www /home/httpd/perl/Autocreate.pl
40: #
41: use strict;
42: use lib '/home/httpd/lib/perl';
43: use Apache::lonnet;
44: use Apache::lonlocal;
45: use Apache::loncoursequeueadmin;
46: use LONCAPA::batchcreatecourse;
47: use LONCAPA::Configuration;
48: use LONCAPA();
49:
50: my $perlvarref = &LONCAPA::Configuration::read_conf('loncapa.conf');
51: my $logfile = $$perlvarref{'lonDaemons'}.'/logs/autocreate.log';
52: my @machinedoms = sort(&Apache::lonnet::current_machine_domains());
53: my @ids=&Apache::lonnet::current_machine_ids();
54: my (@libids,@domains);
55: foreach my $id (@ids) {
56: if (&Apache::lonnet::is_library($id)) {
57: push(@libids,$id);
58: }
59: }
60: exit if (!@libids);
61: foreach my $dom (@machinedoms) {
62: my $primary = &Apache::lonnet::domain($dom,'primary');
63: if (grep(/^\Q$primary\E$/,@libids)) {
64: unless (grep(/^\Q$dom\E$/,@domains)) {
65: push(@domains,$dom);
66: }
67: }
68: }
69: exit if (!@domains);
70: open (my $fh,">>$logfile");
71: print $fh "********************\n".localtime(time)." Autocreation messages start --\n";
72: my $wwwid=getpwnam('www');
73: if ($wwwid!=$<) {
74: my $emailto=$$perlvarref{'lonAdmEMail'};
75: my $subj="LON: $$perlvarref{'lonHostID'} User ID mismatch";
76: my $requestmail = "To: $emailto\n";
77: $requestmail .=
78: "Subject: LON: $$perlvarref{'lonHostID'} User ID mismatch\n".
79: "User ID mismatch. Autocreate.pl must be run as user www\n";
80: if ($emailto =~ /^[^\@]+\@[^\@]+$/) {
81: if (open(MAIL, "|/usr/lib/sendmail -oi -t -odb")) {
82: print MAIL $requestmail;
83: close(MAIL);
84: print $fh "Autocreate.pl must be run as user www\n\n";
85: } else {
86: print $fh "Could not send notification e-mail to $emailto\n\n";
87: }
88: } else {
89: print $fh "Notification e-mail address for Administrator is not a valid e-mail address\n\n";
90: }
91: close($fh);
92: exit;
93: }
94: if (@ARGV) {
95: # check if specified course domain is a domain hosted on this library server.
96: if (!grep(/^\Q$ARGV[0]\E$/,@domains)) {
97: print $fh "The domain you supplied is not a valid domain for this server\n";
98: close($fh);
99: exit;
100: } elsif (@ARGV < 2) {
101: print $fh "usage: ./Autocreate <coursedomain username:domain>.\nPlease provide the username and domain of a Domain Coordinator, if you provide a coursedomain.\nThe script can also be called without any arguments, in which case domain configuration data for domains hosted on this server will be used.\n";
102: close($fh);
103: exit;
104: } else {
105: my $defdom = $ARGV[0];
106: my ($dcname,$dcdom) = ($ARGV[1] =~ /^([^:]+):([^:]+)$/);
107: # check if user is an active domain coordinator.
108: if (!&check_activedc($dcdom,$dcname,$defdom)) {
109: print $fh "The username you supplied for domain $defdom does not have an active domain coordinator role in the domain\n\n";
110: close($fh);
111: exit;
112: }
113: my $output = &process_xml($fh,$defdom,$dcname,$dcdom);
114: print $output;
115: }
116: } else {
117: my $reqsnamespace = 'courserequestqueue';
118: my @courseroles = ('cc','in','ta','ep','ad','st');
119: my %longroles;
120: foreach my $role (@courseroles) {
121: $longroles{$role}=&Apache::lonnet::plaintext($role);
122: }
123: my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst');
124: my %permissionflags = ();
125: &set_permissions(\%permissionflags,\@permissions);
126: foreach my $dom (@domains) {
127: my %domconfig = &Apache::lonnet::get_dom('configuration',
128: ['autocreate'],$dom);
129: #only run if configured to
130: my $xml_update = 0;
131: my $settings;
132: if (ref($domconfig{'autocreate'}) eq 'HASH') {
133: $settings = $domconfig{'autocreate'};
134: if ($settings->{'xml'}) {
135: if ($settings->{'xmldc'}) {
136: my ($dcname,$dcdom) = split(':',$settings->{'xmldc'});
137: $env{'user.name'} = $dcname;
138: $env{'user.domain'} = $dcdom;
139: $env{'request.role.domain'} = $dom;
140: if (!&check_activedc($dcdom,$dcname,$dom)) {
141: print $fh "Autocreate.pl in domain $dom configured to run under the auspices of a user without an active domain coordinator role in the domain - course creation will be skipped.\n\n";
142: next;
143: } else {
144: &process_xml($fh,$dom,$dcname,$dcdom);
145: }
146: } else {
147: print $fh "Autocreate.pl in domain $dom - no specified DC under whose identity course creation will occur - domain skipped.\n\n";
148: }
149: }
150: if ($settings->{'req'}) {
151: my %domdefs = &Apache::lonnet::get_domain_defaults($dom);
152: &process_official_reqs($fh,$dom,$reqsnamespace,\%longroles,\%domdefs);
153: }
154: }
155: }
156: &unset_permissions(\%permissionflags);
157: }
158: print $fh "-- ".localtime(time)." Autocreation messages end\n*******************\n\n";
159: close($fh);
160:
161:
162: sub process_xml {
163: my ($fh,$dom,$dcname,$dcdom) = @_;
164: $env{'user.name'} = $dcname;
165: $env{'user.domain'} = $dcdom;
166: $env{'request.role.domain'} = $dom;
167:
168: # Initialize language handler
169: &Apache::lonlocal::get_language_handle();
170:
171: my $batchdir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$dom.'/auto';
172: opendir(DIR,"$batchdir/pending");
173: my @requests = grep(!/^\.\.?$/,readdir(DIR));
174: closedir(DIR);
175: my %courseids = ();
176: print $fh "Sending to batch - auto,$dom,$dcname,$dcdom ".join(":",@requests)."\n";
177: my ($result,$logmsg) = &LONCAPA::batchcreatecourse::create_courses(\@requests,\%courseids,'auto',$dom,$dcname,$dcdom);
178: my $outcome;
179: if ($result ne '') {
180: $outcome = $result."\n";
181: }
182: if ($logmsg ne '') {
183: $outcome .= $logmsg."\n";
184: }
185: print $fh $outcome;
186:
187: my $output;
188: # Copy requests from pending directory to processed directory and unlink.
189: foreach my $request (@requests) {
190: if ((-e "$batchdir/pending/$request") && $request !~ /\.\./ && $request ne '' &&$request ne './') {
191: open(FILE,"<$batchdir/pending/$request");
192: my @buffer = <FILE>;
193: close(FILE);
194: if (!-e "$batchdir/processed") {
195: mkdir("$batchdir/processed", 0755);
196: }
197: open(FILE,">$batchdir/processed/$request");
198: print FILE @buffer;
199: close(FILE);
200: if (-e "$batchdir/processed/$request") {
201: unlink("$batchdir/pending/$request");
202: }
203: }
204: }
205: foreach my $key (sort(keys(%courseids))) {
206: print $fh "created course: $key - $courseids{$key}\n";
207: my $newcourse = &LONCAPA::escape($key.':'.$courseids{$key});
208: $output .= $newcourse.':';
209: }
210: $output =~ s/:$//;
211: delete($env{'user.name'});
212: delete($env{'user.domain'});
213: delete($env{'request.role.domain'});
214: return $output;
215: }
216:
217: sub process_official_reqs {
218: my ($fh,$dom,$reqsnamespace,$longroles,$domdefs) = @_;
219: my %newcids;
220: my %requesthash =
221: &Apache::lonnet::dump_dom($reqsnamespace,$dom,undef,'_pending');
222: foreach my $key (keys(%requesthash)) {
223: my ($cnum,$status) = split('_',$key);
224: next if (&Apache::lonnet::homeserver($cnum,$dom) ne 'no_host');
225: if (ref($requesthash{$key}) eq 'HASH') {
226: my $ownername = $requesthash{$key}{'ownername'};
227: my $ownerdom = $requesthash{$key}{'ownerdom'};
228: next if (&Apache::lonnet::homeserver($ownername,$ownerdom) eq 'no_host');
229: my $inststatus;
230: my %userenv =
231: &Apache::lonnet::get('environment',['inststatus'],
232: $ownerdom,$ownername);
233: my ($tmp) = keys(%userenv);
234: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
235: $inststatus = $userenv{'inststatus'};
236: } else {
237: undef(%userenv);
238: }
239: my $reqkey = $dom.'_'.$cnum;
240: my %history = &Apache::lonnet::restore($reqkey,'courserequests',
241: $ownerdom,$ownername);
242: if (ref($history{'details'}) eq 'HASH') {
243: my $instcode = $history{'details'}{'instcode'};
244: my $crstype = $history{'details'}{'crstype'};
245: my $reqtime = $history{'details'}{'reqtime'};
246: my $cdescr = $history{'details'}{'cdescr'};
247: my @currsec;
248: my $sections = $history{'details'}{'sections'};
249: if (ref($sections) eq 'HASH') {
250: foreach my $i (sort(keys(%{$sections}))) {
251: if (ref($sections->{$i}) eq 'HASH') {
252: my $sec = $sections->{$i}{'inst'};
253: if (!grep(/^\Q$sec\E$/,@currsec)) {
254: push(@currsec,$sec);
255: }
256: }
257: }
258: }
259: my $instseclist = join(',',@currsec);
260: my ($validationchk,$disposition,$reqstatus,$message,
261: $validation,$validationerror);
262: $validationchk =
263: &Apache::lonnet::auto_courserequest_validation($dom,
264: $ownername.':'.$ownerdom,$crstype,$inststatus,
265: $instcode,$instseclist);
266: if ($validationchk =~ /:/) {
267: ($validation,$message) = split(':',$validationchk);
268: } else {
269: $validation = $validationchk;
270: }
271: if ($validation =~ /^error(.*)$/) {
272: $disposition = 'approval';
273: $validationerror = $1;
274: } else {
275: $disposition = $validation;
276: }
277: $reqstatus = $disposition;
278: if ($disposition eq 'process') {
279: my ($logmsg,$newusermsg,$addresult,$enrollcount,$response,$keysmsg);
280: my $result = &Apache::loncoursequeueadmin::course_creation($dom,$cnum,'domain',$history{'details'},\$logmsg,\$newusermsg,\$addresult,\$enrollcount,\$response,\$keysmsg,$domdefs,$longroles);
281: if ($result eq 'created') {
282: $disposition = 'created';
283: $reqstatus = 'created';
284: push(@{$newcids{$instcode}},$dom.'_'.$cnum);
285: }
286: } elsif ($disposition eq 'rejected') {
287: print $fh &mt('Queued course request for [_1] submitted by [_2] with status [_3] rejected when validating',$instcode,$ownername.':'.$ownerdom,$inststatus);
288: } elsif ($disposition eq 'approval') {
289: print $fh &mt('Queued course request for [_1] submitted by [_2] with status [_3] switched to "approval by DC" because of validation error: [_4].',$instcode,$ownername.':'.$ownerdom,$inststatus,$validationerror);
290:
291: my $requestid = $cnum.'_'.$disposition;
292: my $request = {
293: $requestid => {
294: timestamp => $reqtime,
295: crstype => $crstype,
296: ownername => $ownername,
297: ownerdom => $ownerdom,
298: description => $cdescr,
299: },
300: };
301: my $putresult = &Apache::lonnet::newput_dom('courserequestqueue',$request,$dom);
302: unless ($putresult eq 'ok') {
303: print $fh &mt("An error occurred saving the modified course request for [_1] submitted by [_2] in the domain's courserequestqueue.db.",$instcode,$ownername.':'.$ownerdom);
304: }
305: }
306: unless ($disposition eq 'pending') {
307: my ($statusresult,$output) =
308: &Apache::loncoursequeueadmin::update_coursereq_status(\%requesthash,
309: $dom,$cnum,$reqstatus,'domain');
310: unless (&Apache::lonnet::del_dom($reqsnamespace,[$cnum.'_pending'],$dom) eq 'ok') {
311: print $fh &mt('An error occurred when removing the request for [_1] submitted by [_2] from the pending queue.',$instcode,$ownername.':'.$ownerdom);
312: }
313: }
314: }
315: }
316: }
317: foreach my $key (sort(keys(%newcids))) {
318: if (ref($newcids{$key}) eq 'ARRAY') {
319: print $fh "created course from queued request: $key - ".join(', ',@{$newcids{$key}})."\n";
320: my $newcourse = &LONCAPA::escape($key.':'.$newcids{$key});
321: }
322: }
323: return;
324: }
325:
326: sub check_activedc {
327: my ($dcdom,$dcname,$defdom) = @_;
328: my %dumphash=
329: &Apache::lonnet::dump('roles',$dcdom,$dcname);
330: my $now=time;
331: my $activedc = 0;
332: foreach my $item (keys %dumphash) {
333: my ($domain,$role) = ($item =~ m-^/([^/]+)/[^_]*_(\w+)$-);
334: if ($role eq 'dc' && $domain eq $defdom) {
335: my ($trole,$tend,$tstart)=split(/_/,$dumphash{$item});
336: if (($tend) && ($tend<$now)) { next; }
337: if (($tstart) && ($now<$tstart)) { next; }
338: $activedc = 1;
339: last;
340: }
341: }
342: return $activedc;
343: }
344:
345: sub set_permissions {
346: my ($permissionflags,$permissions) = @_;
347: foreach my $allowtype (@{$permissions}) {
348: unless($env{"allowed.$allowtype"}) {
349: $env{"allowed.$allowtype"} = 'F';
350: $permissionflags->{$allowtype} = 1;
351: }
352: }
353: }
354:
355: sub unset_permissions {
356: my ($permissionflags) = @_;
357: foreach my $allowtype (keys(%{$permissionflags})) {
358: delete($env{"allowed.$allowtype"});
359: }
360: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>