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.

    1: #!/usr/bin/perl
    2: #
    3: # Automated Course Creation script
    4: #
    5: # $Id: Autocreate.pl,v 1.12 2010/02/22 03:44:21 raeburn Exp $
    6: #
    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. Called from an entry in /etc/cron.d/loncapa
   30: # either with command line args:
   31: #
   32: # www /home/httpd/perl/Autocreate.pl $dom $uname:$udom
   33: #
   34: # where $dom is the name of the course domain, $uname and $udom are the
   35: # username and domain of a Domain Coordinator in the domain.
   36: #
   37: # or without args (default) controlled by domain configuration settings:
   38: #
   39: # www /home/httpd/perl/Autocreate.pl  
   40: #
   41:     use strict;
   42:     use lib '/home/httpd/lib/perl';
   43:     use Apache::lonnet;
   44:     use Apache::lonlocal;
   45:     use Apache::loncoursequeueadmin;
   46:     use LONCAPA::batchcreatecourse;
   47:     use LONCAPA::Configuration;
   48:     use LONCAPA();
   49: 
   50:     my $perlvarref = &LONCAPA::Configuration::read_conf('loncapa.conf');
   51:     my $logfile = $$perlvarref{'lonDaemons'}.'/logs/autocreate.log';
   52:     my @machinedoms = sort(&Apache::lonnet::current_machine_domains());
   53:     my @ids=&Apache::lonnet::current_machine_ids();
   54:     my (@libids,@domains);
   55:     foreach my $id (@ids) {
   56:         if (&Apache::lonnet::is_library($id)) {
   57:             push(@libids,$id);
   58:         }
   59:     }
   60:     exit if (!@libids); 
   61:     foreach my $dom (@machinedoms) {
   62:         my $primary = &Apache::lonnet::domain($dom,'primary');
   63:         if (grep(/^\Q$primary\E$/,@libids)) {
   64:             unless (grep(/^\Q$dom\E$/,@domains)) {
   65:                 push(@domains,$dom);
   66:             }
   67:         }
   68:     }
   69:     exit if (!@domains);
   70:     open (my $fh,">>$logfile");
   71:     print $fh "********************\n".localtime(time)." Autocreation messages start --\n";
   72:     my $wwwid=getpwnam('www');
   73:     if ($wwwid!=$<) {
   74:         my $emailto=$$perlvarref{'lonAdmEMail'};
   75:         my $subj="LON: $$perlvarref{'lonHostID'} User ID mismatch";
   76:         my $requestmail = "To: $emailto\n";
   77:         $requestmail .=
   78:         "Subject: LON: $$perlvarref{'lonHostID'} User ID mismatch\n".
   79:         "User ID mismatch. Autocreate.pl must be run as user www\n";
   80:         if ($emailto =~ /^[^\@]+\@[^\@]+$/) {
   81:             if (open(MAIL, "|/usr/lib/sendmail -oi -t -odb")) {
   82:                 print MAIL $requestmail;
   83:                 close(MAIL);
   84:                 print $fh "Autocreate.pl must be run as user www\n\n";
   85:             } else {
   86:                 print $fh "Could not send notification e-mail to $emailto\n\n";
   87:             }
   88:         } else {
   89:             print $fh "Notification e-mail address for Administrator is not a valid e-mail address\n\n";
   90:         }
   91:         close($fh);
   92:         exit;
   93:     }
   94:     if (@ARGV) {
   95: # check if specified course domain is a domain hosted on this library server.
   96:         if (!grep(/^\Q$ARGV[0]\E$/,@domains)) {
   97:             print $fh "The domain you supplied is not a valid domain for this server\n";
   98:             close($fh);
   99:             exit;
  100:         } elsif (@ARGV < 2) {
  101:             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";
  102:             close($fh);
  103:             exit;
  104:         } else {
  105:             my $defdom = $ARGV[0];
  106:             my ($dcname,$dcdom) = ($ARGV[1] =~ /^([^:]+):([^:]+)$/);
  107: # check if user is an active domain coordinator.
  108:             if (!&check_activedc($dcdom,$dcname,$defdom)) {
  109:                 print $fh "The username you supplied for domain $defdom does not have an active domain coordinator role in the domain\n\n";
  110:                 close($fh);
  111:                 exit;
  112:             }
  113:             my $output = &process_xml($fh,$defdom,$dcname,$dcdom);
  114:             print $output;
  115:         }
  116:     } else {
  117:         my $reqsnamespace = 'courserequestqueue';
  118:         my @courseroles = ('cc','in','ta','ep','ad','st');
  119:         my %longroles;
  120:         foreach my $role (@courseroles) {
  121:             $longroles{$role}=&Apache::lonnet::plaintext($role);
  122:         }
  123:         my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst');
  124:         my %permissionflags = ();
  125:         &set_permissions(\%permissionflags,\@permissions);
  126:         foreach my $dom (@domains) {
  127:             my %domconfig = &Apache::lonnet::get_dom('configuration',
  128:                                                      ['autocreate'],$dom);
  129:             #only run if configured to
  130:             my $xml_update = 0;
  131:             my $settings;
  132:             if (ref($domconfig{'autocreate'}) eq 'HASH') {
  133:                 $settings = $domconfig{'autocreate'};
  134:                 if ($settings->{'xml'}) {
  135:                     if ($settings->{'xmldc'}) {
  136:                         my ($dcname,$dcdom) = split(':',$settings->{'xmldc'});
  137:                         $env{'user.name'} = $dcname;
  138:                         $env{'user.domain'} = $dcdom;
  139:                         $env{'request.role.domain'} = $dom;
  140:                         if (!&check_activedc($dcdom,$dcname,$dom)) {
  141:                             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";
  142:                             next;
  143:                         } else {
  144:                             &process_xml($fh,$dom,$dcname,$dcdom);
  145:                         }
  146:                     } else {
  147:                         print $fh "Autocreate.pl in domain $dom - no specified DC under whose identity course creation will occur - domain skipped.\n\n";
  148:                     }
  149:                 }
  150:                 if ($settings->{'req'}) {
  151:                     my %domdefs = &Apache::lonnet::get_domain_defaults($dom);
  152:                     &process_official_reqs($fh,$dom,$reqsnamespace,\%longroles,\%domdefs);
  153:                 }
  154:             }
  155:         }
  156:         &unset_permissions(\%permissionflags);
  157:     }
  158:     print $fh "-- ".localtime(time)." Autocreation messages end\n*******************\n\n";
  159:     close($fh);
  160: 
  161: 
  162: sub process_xml {
  163:     my ($fh,$dom,$dcname,$dcdom) = @_;
  164:     $env{'user.name'} = $dcname;
  165:     $env{'user.domain'} = $dcdom;
  166:     $env{'request.role.domain'} = $dom;
  167: 
  168:     # Initialize language handler
  169:     &Apache::lonlocal::get_language_handle();
  170: 
  171:     my $batchdir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$dom.'/auto';
  172:     opendir(DIR,"$batchdir/pending");
  173:     my @requests = grep(!/^\.\.?$/,readdir(DIR));
  174:     closedir(DIR);
  175:     my %courseids = ();
  176:     print $fh "Sending to batch - auto,$dom,$dcname,$dcdom ".join(":",@requests)."\n";
  177:     my ($result,$logmsg) = &LONCAPA::batchcreatecourse::create_courses(\@requests,\%courseids,'auto',$dom,$dcname,$dcdom);
  178:     my $outcome;
  179:     if ($result ne '') {
  180:         $outcome = $result."\n";
  181:     }
  182:     if ($logmsg ne '') {
  183:         $outcome .= $logmsg."\n";    
  184:     }
  185:     print $fh $outcome;
  186: 
  187:     my $output;
  188: # Copy requests from pending directory to processed directory and unlink.
  189:     foreach my $request (@requests) {  
  190:         if ((-e "$batchdir/pending/$request") && $request !~ /\.\./ && $request ne '' &&$request ne './') {
  191:             open(FILE,"<$batchdir/pending/$request");
  192:             my @buffer = <FILE>;
  193:             close(FILE);
  194:             if (!-e "$batchdir/processed") {
  195:                 mkdir("$batchdir/processed", 0755);
  196:             }
  197:             open(FILE,">$batchdir/processed/$request");
  198:             print FILE @buffer;
  199:             close(FILE);
  200:             if (-e "$batchdir/processed/$request") {
  201:                 unlink("$batchdir/pending/$request");
  202:             }
  203:         }
  204:     }
  205:     foreach my $key (sort(keys(%courseids))) {
  206:         print $fh "created course: $key - $courseids{$key}\n";
  207:         my $newcourse = &LONCAPA::escape($key.':'.$courseids{$key});
  208:         $output .= $newcourse.':';
  209:     }
  210:     $output =~ s/:$//;
  211:     delete($env{'user.name'});
  212:     delete($env{'user.domain'});
  213:     delete($env{'request.role.domain'});
  214:     return $output;
  215: }
  216: 
  217: sub process_official_reqs {
  218:     my ($fh,$dom,$reqsnamespace,$longroles,$domdefs) = @_;
  219:     my %newcids;
  220:     my %requesthash = 
  221:         &Apache::lonnet::dump_dom($reqsnamespace,$dom,undef,'_pending');
  222:     foreach my $key (keys(%requesthash)) {
  223:         my ($cnum,$status) = split('_',$key);
  224:         next if (&Apache::lonnet::homeserver($cnum,$dom) ne 'no_host');
  225:         if (ref($requesthash{$key}) eq 'HASH') {
  226:             my $ownername = $requesthash{$key}{'ownername'};
  227:             my $ownerdom = $requesthash{$key}{'ownerdom'};
  228:             next if (&Apache::lonnet::homeserver($ownername,$ownerdom) eq 'no_host');
  229:             my $inststatus;
  230:             my %userenv =
  231:                 &Apache::lonnet::get('environment',['inststatus'],
  232:                                      $ownerdom,$ownername);
  233:             my ($tmp) = keys(%userenv);
  234:             if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
  235:                 $inststatus = $userenv{'inststatus'};
  236:             } else {
  237:                 undef(%userenv);
  238:             }
  239:             my $reqkey = $dom.'_'.$cnum;
  240:             my %history = &Apache::lonnet::restore($reqkey,'courserequests',
  241:                                                    $ownerdom,$ownername);
  242:             if (ref($history{'details'}) eq 'HASH') {
  243:                 my $instcode = $history{'details'}{'instcode'};
  244:                 my $crstype = $history{'details'}{'crstype'};
  245:                 my $reqtime = $history{'details'}{'reqtime'};
  246:                 my $cdescr = $history{'details'}{'cdescr'};
  247:                 my @currsec;
  248:                 my $sections = $history{'details'}{'sections'};
  249:                 if (ref($sections) eq 'HASH') {
  250:                     foreach my $i (sort(keys(%{$sections}))) {
  251:                         if (ref($sections->{$i}) eq 'HASH') {
  252:                             my $sec = $sections->{$i}{'inst'};
  253:                             if (!grep(/^\Q$sec\E$/,@currsec)) {
  254:                                 push(@currsec,$sec);
  255:                             }
  256:                         }
  257:                     }
  258:                 }
  259:                 my $instseclist = join(',',@currsec);
  260:                 my ($validationchk,$disposition,$reqstatus,$message,
  261:                     $validation,$validationerror);
  262:                 $validationchk =
  263:                     &Apache::lonnet::auto_courserequest_validation($dom,
  264:                         $ownername.':'.$ownerdom,$crstype,$inststatus,
  265:                         $instcode,$instseclist);
  266:                 if ($validationchk =~ /:/) {
  267:                     ($validation,$message) = split(':',$validationchk);
  268:                 } else {
  269:                     $validation = $validationchk;
  270:                 }
  271:                 if ($validation =~ /^error(.*)$/) {
  272:                     $disposition = 'approval';
  273:                     $validationerror = $1;
  274:                 } else {
  275:                     $disposition = $validation;
  276:                 }
  277:                 $reqstatus = $disposition;
  278:                 if ($disposition eq 'process') {
  279:                     my ($logmsg,$newusermsg,$addresult,$enrollcount,$response,$keysmsg);
  280:                     my $result = &Apache::loncoursequeueadmin::course_creation($dom,$cnum,'domain',$history{'details'},\$logmsg,\$newusermsg,\$addresult,\$enrollcount,\$response,\$keysmsg,$domdefs,$longroles);
  281:                     if ($result eq 'created') {
  282:                         $disposition = 'created';
  283:                         $reqstatus = 'created';
  284:                         push(@{$newcids{$instcode}},$dom.'_'.$cnum);
  285:                     }
  286:                 } elsif ($disposition eq 'rejected') {
  287:                     print $fh &mt('Queued course request for [_1] submitted by [_2] with status [_3] rejected when validating',$instcode,$ownername.':'.$ownerdom,$inststatus);
  288:                 } elsif ($disposition eq 'approval') {
  289:                     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);
  290: 
  291:                     my $requestid = $cnum.'_'.$disposition;
  292:                     my $request = {
  293:                             $requestid => {
  294:                                             timestamp   => $reqtime,
  295:                                             crstype     => $crstype,
  296:                                             ownername   => $ownername,
  297:                                             ownerdom    => $ownerdom,
  298:                                             description => $cdescr,
  299:                                           },
  300:                           };
  301:                     my $putresult = &Apache::lonnet::newput_dom('courserequestqueue',$request,$dom);
  302:                     unless ($putresult eq 'ok') {
  303:                         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);   
  304:                     }
  305:                 }
  306:                 unless ($disposition eq 'pending') {
  307:                     my ($statusresult,$output) = 
  308:                         &Apache::loncoursequeueadmin::update_coursereq_status(\%requesthash,
  309:                             $dom,$cnum,$reqstatus,'domain');
  310:                     unless (&Apache::lonnet::del_dom($reqsnamespace,[$cnum.'_pending'],$dom) eq 'ok') {
  311:                         print $fh &mt('An error occurred when removing the request for [_1] submitted by [_2] from the pending queue.',$instcode,$ownername.':'.$ownerdom);
  312:                     }
  313:                 }
  314:             }
  315:         }
  316:     }
  317:     foreach my $key (sort(keys(%newcids))) {
  318:         if (ref($newcids{$key}) eq 'ARRAY') {
  319:             print $fh "created course from queued request: $key - ".join(', ',@{$newcids{$key}})."\n";
  320:             my $newcourse = &LONCAPA::escape($key.':'.$newcids{$key});
  321:         }
  322:     }
  323:     return;
  324: }
  325: 
  326: sub check_activedc {
  327:     my ($dcdom,$dcname,$defdom) = @_;
  328:     my %dumphash=
  329:             &Apache::lonnet::dump('roles',$dcdom,$dcname);
  330:     my $now=time;
  331:     my $activedc = 0;
  332:     foreach my $item (keys %dumphash) {
  333:         my ($domain,$role) = ($item =~ m-^/([^/]+)/[^_]*_(\w+)$-);
  334:         if ($role eq 'dc' && $domain eq $defdom) {
  335:             my ($trole,$tend,$tstart)=split(/_/,$dumphash{$item});
  336:             if (($tend) && ($tend<$now)) { next; }
  337:             if (($tstart) && ($now<$tstart)) { next; }
  338:             $activedc = 1;
  339:             last;
  340:         }
  341:     }
  342:     return $activedc;
  343: }
  344: 
  345: sub set_permissions {
  346:     my ($permissionflags,$permissions) = @_;
  347:     foreach my $allowtype (@{$permissions}) {
  348:         unless($env{"allowed.$allowtype"}) {
  349:             $env{"allowed.$allowtype"} = 'F';
  350:             $permissionflags->{$allowtype} = 1;
  351:         }
  352:     }
  353: }
  354: 
  355: sub unset_permissions {
  356:     my ($permissionflags) = @_;
  357:     foreach my $allowtype (keys(%{$permissionflags})) {
  358:         delete($env{"allowed.$allowtype"});
  359:     }
  360: }