Annotation of loncom/automation/Autocreate.pl, revision 1.11
1.1 raeburn 1: #!/usr/bin/perl
2: #
3: # Automated Course Creation script
4: #
1.11 ! raeburn 5: # $Id: Autocreate.pl,v 1.10 2008/03/18 20:51:12 raeburn Exp $
1.9 raeburn 6: #
1.1 raeburn 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. Call this from an entry in /etc/cron.d/loncapa
30: #
31: # www /home/httpd/perl/Autocreate.pl $dom $uname:$udom
32: #
33: # where $dom is the name of the course domain, $uname and $udom are the
34: # username and domain of a Domain Coordinator in the domain.
35: #
36: use strict;
37: use lib '/home/httpd/lib/perl';
38: use Apache::lonnet;
1.6 raeburn 39: use Apache::lonlocal;
1.1 raeburn 40: use LONCAPA::batchcreatecourse;
41: use LONCAPA::Configuration;
1.11 ! raeburn 42: use LONCAPA();
1.1 raeburn 43:
44: my $perlvarref = &LONCAPA::Configuration::read_conf('loncapa.conf');
45: my $logfile = $$perlvarref{'lonDaemons'}.'/logs/autocreate.log';
46: my @domains = &Apache::lonnet::current_machine_domains();
47: open (my $fh,">>$logfile");
48: print $fh "********************\n".localtime(time)." Autocreation messages start --\n";
49: if (@ARGV < 2) {
50: print $fh "usage: ./Autocreate <coursedomain username:domain>.\nPlease provide the username and domain of a Domain Coordinator.\n";
51: exit;
52: }
53: # check if $defdom is a domain hosted on this library server.
54: my $defdom = $ARGV[0];
55: my ($dcname,$dcdom) = ($ARGV[1] =~ /^([^:]+):([^:]+)$/);
56: if ($defdom eq '' || !grep/^$defdom$/,@domains) {
57: print $fh "The domain you supplied is not a valid domain for this server\n\n";
58: close($fh);
59: exit;
60: }
61: # check if user is an active domain coordinator.
62: if (!&check_activedc($dcdom,$dcname,$defdom)) {
63: print $fh "The username you supplied for domain $defdom does not have an active domain coordinator role in the domain\n\n";
64: close($fh);
65: exit;
66: }
1.6 raeburn 67:
68: # Initialize language handler
69: &Apache::lonlocal::get_language_handle();
70:
1.1 raeburn 71: my $batchdir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$defdom.'/auto';
72: opendir(DIR,"$batchdir/pending");
73: my @requests = grep(!/^\.\.?$/,readdir(DIR));
74: closedir(DIR);
75: my %courseids = ();
1.5 raeburn 76: my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst');
1.3 raeburn 77: my %permissionflags = ();
78: &set_permissions(\%permissionflags,\@permissions);
1.4 raeburn 79: $env{'user.name'} = $dcname;
80: $env{'user.domain'} = $dcdom;
1.6 raeburn 81: $env{'request.role.domain'} = $defdom;
1.1 raeburn 82: my $wwwid=getpwnam('www');
83: if ($wwwid!=$<) {
84: my $emailto=$$perlvarref{'lonAdmEMail'};
85: my $subj="LON: $$perlvarref{'lonHostID'} User ID mismatch";
86: my $requestmail = "To: $emailto\n";
87: $requestmail .=
88: "Subject: LON: $$perlvarref{'lonHostID'} User ID mismatch\n".
89: "User ID mismatch. Autocreate.pl must be run as user www\n";
90: if ($emailto =~ /^[^\@]+\@[^\@]+$/) {
91: if (open(MAIL, "|/usr/lib/sendmail -oi -t -odb")) {
92: print MAIL $requestmail;
93: close(MAIL);
94: print $fh "Autocreate.pl must be run as user www\n\n";
95: } else {
96: print $fh "Could not send notification e-mail to $emailto\n\n";
97: }
98: } else {
99: print $fh "Notification e-mail address for Administrator is not a valid e-mail address\n\n";
100: }
101: close($fh);
102: exit;
103: }
104:
1.3 raeburn 105: print $fh "Sending to batch - auto,$defdom,$dcname,$dcdom ".join(":",@requests)."\n";
106: my ($result,$logmsg) = &LONCAPA::batchcreatecourse::create_courses(\@requests,\%courseids,'auto',$defdom,$dcname,$dcdom);
1.8 raeburn 107: my $outcome;
1.7 raeburn 108: if ($result ne '') {
1.8 raeburn 109: $outcome = $result."\n";
1.7 raeburn 110: }
111: if ($logmsg ne '') {
1.8 raeburn 112: $outcome .= $logmsg."\n";
1.7 raeburn 113: }
1.8 raeburn 114: print $fh $outcome;
1.1 raeburn 115:
1.8 raeburn 116: my $output;
1.1 raeburn 117: # Copy requests from pending directory to processed directory and unlink.
1.8 raeburn 118: foreach my $request (@requests) {
1.1 raeburn 119: if ((-e "$batchdir/pending/$request") && $request !~ /\.\./ && $request ne '' &&$request ne './') {
120: open(FILE,"<$batchdir/pending/$request");
121: my @buffer = <FILE>;
122: close(FILE);
1.3 raeburn 123: if (!-e "$batchdir/processed") {
124: mkdir("$batchdir/processed", 0755);
125: }
1.1 raeburn 126: open(FILE,">$batchdir/processed/$request");
127: print FILE @buffer;
128: close(FILE);
129: if (-e "$batchdir/processed/$request") {
130: unlink("$batchdir/pending/$request");
131: }
132: }
133: }
134:
135: foreach my $key (sort keys %courseids) {
1.3 raeburn 136: print $fh "created course: $key - $courseids{$key}\n";
1.11 ! raeburn 137: my $newcourse = &LONCAPA::escape($key.':'.$courseids{$key});
1.3 raeburn 138: $output .= $newcourse.':';
1.1 raeburn 139: }
1.3 raeburn 140: $output =~ s/:$//;
141: print $output;
1.1 raeburn 142:
1.3 raeburn 143: &unset_permissions(\%permissionflags);
1.4 raeburn 144: delete($env{'user.name'});
145: delete($env{'user.domain'});
1.6 raeburn 146: delete($env{'request.role.domain'});
1.1 raeburn 147: print $fh "-- ".localtime(time)." Autocreation messages end\n*******************\n\n";
148: close($fh);
149:
150: sub check_activedc {
151: my ($dcdom,$dcname,$defdom) = @_;
152: my %dumphash=
153: &Apache::lonnet::dump('roles',$dcdom,$dcname);
154: my $now=time;
155: my $activedc = 0;
156: foreach my $item (keys %dumphash) {
157: my ($domain,$role) = ($item =~ m-^/([^/]+)/[^_]*_(\w+)$-);
158: if ($role eq 'dc' && $domain eq $defdom) {
159: my ($trole,$tend,$tstart)=split(/_/,$dumphash{$item});
160: if (($tend) && ($tend<$now)) { next; }
161: if (($tstart) && ($now<$tstart)) { next; }
162: $activedc = 1;
163: last;
164: }
165: }
166: return $activedc;
167: }
1.3 raeburn 168:
169: sub set_permissions {
170: my ($permissionflags,$permissions) = @_;
171: foreach my $allowtype (@{$permissions}) {
1.4 raeburn 172: unless($env{"allowed.$allowtype"}) {
173: $env{"allowed.$allowtype"} = 'F';
1.3 raeburn 174: $permissionflags{$allowtype} = 1;
175: }
176: }
177: }
178:
179: sub unset_permissions {
180: my ($permissionflags) = @_;
181: foreach my $allowtype (keys %{$permissionflags}) {
1.4 raeburn 182: delete($env{"allowed.$allowtype"});
1.3 raeburn 183: }
184: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to Autocreate.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / automation