[LON-CAPA-cvs] cvs: loncom /automation Autocreate.pl

[raeburn]

raeburn		Fri Mar  4 10:09:06 2005 EDT

  Added files:                 
    /loncom/automation	Autocreate.pl 
  Log:
  Script to process course creation requests.  Intended to be run by www as cron job.  
  
  

Index: loncom/automation/Autocreate.pl
+++ loncom/automation/Autocreate.pl
#!/usr/bin/perl
#
# Automated Course Creation script
#
# 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 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;
    }
                                                   
    my $batchdir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$defdom.'/auto';
    opendir(DIR,"$batchdir/pending");
    my @requests = grep(!/^\.\.?$/,readdir(DIR));
    closedir(DIR);
    my %courseids = ();
    my $cccflag = 0;
    unless ($ENV{'allowed.ccc'}) {
        $ENV{'allowed.ccc'} = 'F';
        $cccflag = 1;
    }
    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;
    }

    my ($output,$logmsg) = &LONCAPA::batchcreatecourse::create_courses(\@requests,\%courseids,'auto',$defdom,$dcname,$dcdom);

# 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);
            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\n";
    }

    if ($cccflag) {
        delete($ENV{'allowed.ccc'});
    }
    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;
}