--- loncom/automation/Autocreate.pl 2005/06/01 18:26:20 1.3
+++ loncom/automation/Autocreate.pl 2010/08/13 16:37:30 1.14
@@ -2,6 +2,8 @@
#
# Automated Course Creation script
#
+# $Id: Autocreate.pl,v 1.14 2010/08/13 16:37:30 raeburn Exp $
+#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
@@ -24,68 +26,64 @@
#
# http://www.lon-capa.org/
#
-# Run as www. Call this from an entry in /etc/cron.d/loncapa
+# Run as www. Called from an entry in /etc/cron.d/loncapa
+# either with command line args:
#
# www /home/httpd/perl/Autocreate.pl $dom $uname:$udom
#
-# where $dom is the name of the course domain, $uname and $udom are the
-# username and domain of a Domain Coordinator in the domain.
+# where $dom is the name of the course domain, $uname and $udom are the
+# username and domain of a Domain Coordinator in the domain.
+#
+# or without args (default) controlled by domain configuration settings:
+#
+# www /home/httpd/perl/Autocreate.pl
#
use strict;
use lib '/home/httpd/lib/perl';
use Apache::lonnet;
+ use Apache::lonlocal;
+ use Apache::loncoursequeueadmin;
use LONCAPA::batchcreatecourse;
use LONCAPA::Configuration;
+ use LONCAPA();
my $perlvarref = &LONCAPA::Configuration::read_conf('loncapa.conf');
my $logfile = $$perlvarref{'lonDaemons'}.'/logs/autocreate.log';
- my @domains = &Apache::lonnet::current_machine_domains();
- open (my $fh,">>$logfile");
- print $fh "********************\n".localtime(time)." Autocreation messages start --\n";
- if (@ARGV < 2) {
- print $fh "usage: ./Autocreate <coursedomain username:domain>.\nPlease provide the username and domain of a Domain Coordinator.\n";
- exit;
- }
-# check if $defdom is a domain hosted on this library server.
- my $defdom = $ARGV[0];
- my ($dcname,$dcdom) = ($ARGV[1] =~ /^([^:]+):([^:]+)$/);
- if ($defdom eq '' || !grep/^$defdom$/,@domains) {
- print $fh "The domain you supplied is not a valid domain for this server\n\n";
- close($fh);
- exit;
+ my @machinedoms = sort(&Apache::lonnet::current_machine_domains());
+ my @ids=&Apache::lonnet::current_machine_ids();
+ my (@libids,@domains);
+ foreach my $id (@ids) {
+ if (&Apache::lonnet::is_library($id)) {
+ push(@libids,$id);
+ }
}
-# check if user is an active domain coordinator.
- if (!&check_activedc($dcdom,$dcname,$defdom)) {
- print $fh "The username you supplied for domain $defdom does not have an active domain coordinator role in the domain\n\n";
- close($fh);
- exit;
+ exit if (!@libids);
+ foreach my $dom (@machinedoms) {
+ my $primary = &Apache::lonnet::domain($dom,'primary');
+ if (grep(/^\Q$primary\E$/,@libids)) {
+ unless (grep(/^\Q$dom\E$/,@domains)) {
+ push(@domains,$dom);
+ }
+ }
}
-
- my $batchdir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$defdom.'/auto';
- opendir(DIR,"$batchdir/pending");
- my @requests = grep(!/^\.\.?$/,readdir(DIR));
- closedir(DIR);
- my %courseids = ();
- my @permissions = ('ccc','cin','cta','cep','ccr','cst');
- my %permissionflags = ();
- &set_permissions(\%permissionflags,\@permissions);
- $ENV{'user.name'} = $dcname;
- $ENV{'user.domain'} = $dcdom;
+ exit if (!@domains);
+ open (my $fh,">>$logfile");
+ print $fh "********************\n".localtime(time)." Autocreation messages start --\n";
my $wwwid=getpwnam('www');
if ($wwwid!=$<) {
my $emailto=$$perlvarref{'lonAdmEMail'};
my $subj="LON: $$perlvarref{'lonHostID'} User ID mismatch";
my $requestmail = "To: $emailto\n";
- $requestmail .=
+ $requestmail .=
"Subject: LON: $$perlvarref{'lonHostID'} User ID mismatch\n".
- "User ID mismatch. Autocreate.pl must be run as user www\n";
+ "User ID mismatch. Autocreate.pl must be run as user www\n";
if ($emailto =~ /^[^\@]+\@[^\@]+$/) {
if (open(MAIL, "|/usr/lib/sendmail -oi -t -odb")) {
print MAIL $requestmail;
close(MAIL);
print $fh "Autocreate.pl must be run as user www\n\n";
} else {
- print $fh "Could not send notification e-mail to $emailto\n\n";
+ print $fh "Could not send notification e-mail to $emailto\n\n";
}
} else {
print $fh "Notification e-mail address for Administrator is not a valid e-mail address\n\n";
@@ -93,13 +91,105 @@
close($fh);
exit;
}
+ if (@ARGV) {
+# check if specified course domain is a domain hosted on this library server.
+ if (!grep(/^\Q$ARGV[0]\E$/,@domains)) {
+ print $fh "The domain you supplied is not a valid domain for this server\n";
+ close($fh);
+ exit;
+ } elsif (@ARGV < 2) {
+ 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";
+ close($fh);
+ exit;
+ } else {
+ my $defdom = $ARGV[0];
+ my ($dcname,$dcdom) = ($ARGV[1] =~ /^([^:]+):([^:]+)$/);
+# check if user is an active domain coordinator.
+ if (!&check_activedc($dcdom,$dcname,$defdom)) {
+ print $fh "The username you supplied for domain $defdom does not have an active domain coordinator role in the domain\n\n";
+ close($fh);
+ exit;
+ }
+ $env{'user.name'} = $dcname;
+ $env{'user.domain'} = $dcdom;
+ $env{'request.role.domain'} = $defdom;
+ my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst');
+ my %permissionflags = ();
+ &set_permissions(\%permissionflags,\@permissions);
+ my $output = &process_xml($fh,$defdom,$dcname,$dcdom);
+ print $output;
+ &unset_permissions(\%permissionflags);
+ }
+ } else {
+ my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst');
+ my %permissionflags = ();
+ &set_permissions(\%permissionflags,\@permissions);
+ foreach my $dom (@domains) {
+ my %domconfig = &Apache::lonnet::get_dom('configuration',
+ ['autocreate'],$dom);
+ #only run if configured to
+ my $xml_update = 0;
+ my $settings;
+ if (ref($domconfig{'autocreate'}) eq 'HASH') {
+ $settings = $domconfig{'autocreate'};
+ if ($settings->{'xml'}) {
+ if ($settings->{'xmldc'}) {
+ my ($dcname,$dcdom) = split(':',$settings->{'xmldc'});
+ $env{'user.name'} = $dcname;
+ $env{'user.domain'} = $dcdom;
+ $env{'request.role.domain'} = $dom;
+ if (!&check_activedc($dcdom,$dcname,$dom)) {
+ 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";
+ next;
+ } else {
+ &process_xml($fh,$dom,$dcname,$dcdom);
+ }
+ } else {
+ print $fh "Autocreate.pl in domain $dom - no specified DC under whose identity course creation will occur - domain skipped.\n\n";
+ }
+ }
+ if ($settings->{'req'}) {
+ my $output = &Apache::process_official_reqs('auto',$dom);
+ if ($output) {
+ print $fh $output;
+ }
+ }
+ }
+ }
+ &unset_permissions(\%permissionflags);
+ }
+ print $fh "-- ".localtime(time)." Autocreation messages end\n*******************\n\n";
+ close($fh);
- print $fh "Sending to batch - auto,$defdom,$dcname,$dcdom ".join(":",@requests)."\n";
- my ($result,$logmsg) = &LONCAPA::batchcreatecourse::create_courses(\@requests,\%courseids,'auto',$defdom,$dcname,$dcdom);
- print $fh "$result && $logmsg\n";
+sub process_xml {
+ my ($fh,$dom,$dcname,$dcdom) = @_;
+ $env{'user.name'} = $dcname;
+ $env{'user.domain'} = $dcdom;
+ $env{'request.role.domain'} = $dom;
+
+ # Initialize language handler
+ &Apache::lonlocal::get_language_handle();
+
+ my $batchdir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$dom.'/auto';
+ opendir(DIR,"$batchdir/pending");
+ my @requests = grep(!/^\.\.?$/,readdir(DIR));
+ closedir(DIR);
+ my %courseids = ();
+ print $fh "Sending to batch - auto,$dom,$dcname,$dcdom ".join(":",@requests)."\n";
+ my ($result,$logmsg) = &LONCAPA::batchcreatecourse::create_courses(\@requests,\%courseids,'auto',$dom,$dcname,$dcdom);
+ my $outcome;
+ if ($result ne '') {
+ $outcome = $result."\n";
+ }
+ if ($logmsg ne '') {
+ $outcome .= $logmsg."\n";
+ }
+ print $fh $outcome;
+
+ my $output;
# Copy requests from pending directory to processed directory and unlink.
- foreach my $request (@requests) {
+ foreach my $request (@requests) {
if ((-e "$batchdir/pending/$request") && $request !~ /\.\./ && $request ne '' &&$request ne './') {
open(FILE,"<$batchdir/pending/$request");
my @buffer = <FILE>;
@@ -115,21 +205,17 @@
}
}
}
-
- my $output;
- foreach my $key (sort keys %courseids) {
+ foreach my $key (sort(keys(%courseids))) {
print $fh "created course: $key - $courseids{$key}\n";
- my $newcourse = &Apache::lonnet::escape($key.':'.$courseids{$key});
- $output .= $newcourse.':';
+ my $newcourse = &LONCAPA::escape($key.':'.$courseids{$key});
+ $output .= $newcourse.':';
}
$output =~ s/:$//;
- print $output;
-
- &unset_permissions(\%permissionflags);
- delete($ENV{'user.name'});
- delete($ENV{'user.domain'});
- print $fh "-- ".localtime(time)." Autocreation messages end\n*******************\n\n";
- close($fh);
+ delete($env{'user.name'});
+ delete($env{'user.domain'});
+ delete($env{'request.role.domain'});
+ return $output;
+}
sub check_activedc {
my ($dcdom,$dcname,$defdom) = @_;
@@ -153,16 +239,16 @@ sub check_activedc {
sub set_permissions {
my ($permissionflags,$permissions) = @_;
foreach my $allowtype (@{$permissions}) {
- unless($ENV{"allowed.$allowtype"}) {
- $ENV{"allowed.$allowtype"} = 'F';
- $permissionflags{$allowtype} = 1;
+ unless($env{"allowed.$allowtype"}) {
+ $env{"allowed.$allowtype"} = 'F';
+ $permissionflags->{$allowtype} = 1;
}
}
}
sub unset_permissions {
my ($permissionflags) = @_;
- foreach my $allowtype (keys %{$permissionflags}) {
- delete($ENV{"allowed.$allowtype"});
+ foreach my $allowtype (keys(%{$permissionflags})) {
+ delete($env{"allowed.$allowtype"});
}
}