Return to Autocreate.pl CVS log

Up to [LON-CAPA] / loncom / automation

- 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.

#!/usr/bin/perl
#
# Automated Course Creation script
#
# $Id: Autocreate.pl,v 1.12 2010/02/22 03:44:21 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. 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.
#
# 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 @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);
        }
    }
    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);
            }
        }
    }
    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 .=
        "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;
    }
    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;
            }
            my $output = &process_xml($fh,$defdom,$dcname,$dcdom);
            print $output;
        }
    } else {
        my $reqsnamespace = 'courserequestqueue';
        my @courseroles = ('cc','in','ta','ep','ad','st');
        my %longroles;
        foreach my $role (@courseroles) {
            $longroles{$role}=&Apache::lonnet::plaintext($role);
        }
        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 %domdefs = &Apache::lonnet::get_domain_defaults($dom);
                    &process_official_reqs($fh,$dom,$reqsnamespace,\%longroles,\%domdefs);
                }
            }
        }
        &unset_permissions(\%permissionflags);
    }
    print $fh "-- ".localtime(time)." Autocreation messages end\n*******************\n\n";
    close($fh);


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) {  
        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 = &LONCAPA::escape($key.':'.$courseids{$key});
        $output .= $newcourse.':';
    }
    $output =~ s/:$//;
    delete($env{'user.name'});
    delete($env{'user.domain'});
    delete($env{'request.role.domain'});
    return $output;
}

sub process_official_reqs {
    my ($fh,$dom,$reqsnamespace,$longroles,$domdefs) = @_;
    my %newcids;
    my %requesthash = 
        &Apache::lonnet::dump_dom($reqsnamespace,$dom,undef,'_pending');
    foreach my $key (keys(%requesthash)) {
        my ($cnum,$status) = split('_',$key);
        next if (&Apache::lonnet::homeserver($cnum,$dom) ne 'no_host');
        if (ref($requesthash{$key}) eq 'HASH') {
            my $ownername = $requesthash{$key}{'ownername'};
            my $ownerdom = $requesthash{$key}{'ownerdom'};
            next if (&Apache::lonnet::homeserver($ownername,$ownerdom) eq 'no_host');
            my $inststatus;
            my %userenv =
                &Apache::lonnet::get('environment',['inststatus'],
                                     $ownerdom,$ownername);
            my ($tmp) = keys(%userenv);
            if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                $inststatus = $userenv{'inststatus'};
            } else {
                undef(%userenv);
            }
            my $reqkey = $dom.'_'.$cnum;
            my %history = &Apache::lonnet::restore($reqkey,'courserequests',
                                                   $ownerdom,$ownername);
            if (ref($history{'details'}) eq 'HASH') {
                my $instcode = $history{'details'}{'instcode'};
                my $crstype = $history{'details'}{'crstype'};
                my $reqtime = $history{'details'}{'reqtime'};
                my $cdescr = $history{'details'}{'cdescr'};
                my @currsec;
                my $sections = $history{'details'}{'sections'};
                if (ref($sections) eq 'HASH') {
                    foreach my $i (sort(keys(%{$sections}))) {
                        if (ref($sections->{$i}) eq 'HASH') {
                            my $sec = $sections->{$i}{'inst'};
                            if (!grep(/^\Q$sec\E$/,@currsec)) {
                                push(@currsec,$sec);
                            }
                        }
                    }
                }
                my $instseclist = join(',',@currsec);
                my ($validationchk,$disposition,$reqstatus,$message,
                    $validation,$validationerror);
                $validationchk =
                    &Apache::lonnet::auto_courserequest_validation($dom,
                        $ownername.':'.$ownerdom,$crstype,$inststatus,
                        $instcode,$instseclist);
                if ($validationchk =~ /:/) {
                    ($validation,$message) = split(':',$validationchk);
                } else {
                    $validation = $validationchk;
                }
                if ($validation =~ /^error(.*)$/) {
                    $disposition = 'approval';
                    $validationerror = $1;
                } else {
                    $disposition = $validation;
                }
                $reqstatus = $disposition;
                if ($disposition eq 'process') {
                    my ($logmsg,$newusermsg,$addresult,$enrollcount,$response,$keysmsg);
                    my $result = &Apache::loncoursequeueadmin::course_creation($dom,$cnum,'domain',$history{'details'},\$logmsg,\$newusermsg,\$addresult,\$enrollcount,\$response,\$keysmsg,$domdefs,$longroles);
                    if ($result eq 'created') {
                        $disposition = 'created';
                        $reqstatus = 'created';
                        push(@{$newcids{$instcode}},$dom.'_'.$cnum);
                    }
                } elsif ($disposition eq 'rejected') {
                    print $fh &mt('Queued course request for [_1] submitted by [_2] with status [_3] rejected when validating',$instcode,$ownername.':'.$ownerdom,$inststatus);
                } elsif ($disposition eq 'approval') {
                    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);

                    my $requestid = $cnum.'_'.$disposition;
                    my $request = {
                            $requestid => {
                                            timestamp   => $reqtime,
                                            crstype     => $crstype,
                                            ownername   => $ownername,
                                            ownerdom    => $ownerdom,
                                            description => $cdescr,
                                          },
                          };
                    my $putresult = &Apache::lonnet::newput_dom('courserequestqueue',$request,$dom);
                    unless ($putresult eq 'ok') {
                        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);   
                    }
                }
                unless ($disposition eq 'pending') {
                    my ($statusresult,$output) = 
                        &Apache::loncoursequeueadmin::update_coursereq_status(\%requesthash,
                            $dom,$cnum,$reqstatus,'domain');
                    unless (&Apache::lonnet::del_dom($reqsnamespace,[$cnum.'_pending'],$dom) eq 'ok') {
                        print $fh &mt('An error occurred when removing the request for [_1] submitted by [_2] from the pending queue.',$instcode,$ownername.':'.$ownerdom);
                    }
                }
            }
        }
    }
    foreach my $key (sort(keys(%newcids))) {
        if (ref($newcids{$key}) eq 'ARRAY') {
            print $fh "created course from queued request: $key - ".join(', ',@{$newcids{$key}})."\n";
            my $newcourse = &LONCAPA::escape($key.':'.$newcids{$key});
        }
    }
    return;
}

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