File:
[LON-CAPA] /
loncom /
automation /
Autocreate.pl
Revision
1.10:
download - view:
text,
annotated -
select for diffs
Tue Mar 18 20:51:12 2008 UTC (16 years, 5 months ago) by
raeburn
Branches:
MAIN
CVS tags:
version_2_8_X,
version_2_8_99_0,
version_2_8_2,
version_2_8_1,
version_2_8_0,
version_2_7_X,
version_2_7_99_1,
version_2_7_99_0,
version_2_7_1,
version_2_7_0,
version_2_6_X,
version_2_6_99_1,
version_2_6_99_0,
version_2_6_3,
bz5969,
bz2851,
HEAD,
GCI_3,
GCI_2,
GCI_1,
BZ5971-printing-apage,
BZ5434-fox
Add version ID
#!/usr/bin/perl
#
# Automated Course Creation script
#
# $Id: Autocreate.pl,v 1.10 2008/03/18 20:51:12 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
# Run as www. Call this from an entry in /etc/cron.d/loncapa
#
# 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.
#
use strict;
use lib '/home/httpd/lib/perl';
use Apache::lonnet;
use Apache::lonlocal;
use LONCAPA::batchcreatecourse;
use LONCAPA::Configuration;
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;
}
# 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;
}
# Initialize language handler
&Apache::lonlocal::get_language_handle();
my $batchdir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$defdom.'/auto';
opendir(DIR,"$batchdir/pending");
my @requests = grep(!/^\.\.?$/,readdir(DIR));
closedir(DIR);
my %courseids = ();
my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst');
my %permissionflags = ();
&set_permissions(\%permissionflags,\@permissions);
$env{'user.name'} = $dcname;
$env{'user.domain'} = $dcdom;
$env{'request.role.domain'} = $defdom;
my $wwwid=getpwnam('www');
if ($wwwid!=$<) {
my $emailto=$$perlvarref{'lonAdmEMail'};
my $subj="LON: $$perlvarref{'lonHostID'} User ID mismatch";
my $requestmail = "To: $emailto\n";
$requestmail .=
"Subject: LON: $$perlvarref{'lonHostID'} User ID mismatch\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";
}
} else {
print $fh "Notification e-mail address for Administrator is not a valid e-mail address\n\n";
}
close($fh);
exit;
}
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);
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) {
if ((-e "$batchdir/pending/$request") && $request !~ /\.\./ && $request ne '' &&$request ne './') {
open(FILE,"<$batchdir/pending/$request");
my @buffer = <FILE>;
close(FILE);
if (!-e "$batchdir/processed") {
mkdir("$batchdir/processed", 0755);
}
open(FILE,">$batchdir/processed/$request");
print FILE @buffer;
close(FILE);
if (-e "$batchdir/processed/$request") {
unlink("$batchdir/pending/$request");
}
}
}
foreach my $key (sort keys %courseids) {
print $fh "created course: $key - $courseids{$key}\n";
my $newcourse = &Apache::lonnet::escape($key.':'.$courseids{$key});
$output .= $newcourse.':';
}
$output =~ s/:$//;
print $output;
&unset_permissions(\%permissionflags);
delete($env{'user.name'});
delete($env{'user.domain'});
delete($env{'request.role.domain'});
print $fh "-- ".localtime(time)." Autocreation messages end\n*******************\n\n";
close($fh);
sub check_activedc {
my ($dcdom,$dcname,$defdom) = @_;
my %dumphash=
&Apache::lonnet::dump('roles',$dcdom,$dcname);
my $now=time;
my $activedc = 0;
foreach my $item (keys %dumphash) {
my ($domain,$role) = ($item =~ m-^/([^/]+)/[^_]*_(\w+)$-);
if ($role eq 'dc' && $domain eq $defdom) {
my ($trole,$tend,$tstart)=split(/_/,$dumphash{$item});
if (($tend) && ($tend<$now)) { next; }
if (($tstart) && ($now<$tstart)) { next; }
$activedc = 1;
last;
}
}
return $activedc;
}
sub set_permissions {
my ($permissionflags,$permissions) = @_;
foreach my $allowtype (@{$permissions}) {
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"});
}
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>