--- loncom/automation/Autocreate.pl	2010/01/31 18:06:10	1.11
+++ loncom/automation/Autocreate.pl	2010/02/22 03:44:21	1.12
@@ -2,7 +2,7 @@
 #
 # Automated Course Creation script
 #
-# $Id: Autocreate.pl,v 1.11 2010/01/31 18:06:10 raeburn Exp $
+# $Id: Autocreate.pl,v 1.12 2010/02/22 03:44:21 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -26,74 +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);
+            }
+        }
     }
-
-    # 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;
+    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";
@@ -101,9 +91,90 @@
         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;
 
-    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);
+    # 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";
@@ -131,21 +202,126 @@
             }
         }
     }
-
-    foreach my $key (sort keys %courseids) {
+    foreach my $key (sort(keys(%courseids))) {
         print $fh "created course: $key - $courseids{$key}\n";
         my $newcourse = &LONCAPA::escape($key.':'.$courseids{$key});
-        $output .= $newcourse.':'; 
+        $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);
+    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) = @_;
@@ -171,14 +347,14 @@ sub set_permissions {
     foreach my $allowtype (@{$permissions}) {
         unless($env{"allowed.$allowtype"}) {
             $env{"allowed.$allowtype"} = 'F';
-            $permissionflags{$allowtype} = 1;
+            $permissionflags->{$allowtype} = 1;
         }
     }
 }
 
 sub unset_permissions {
     my ($permissionflags) = @_;
-    foreach my $allowtype (keys %{$permissionflags}) {
+    foreach my $allowtype (keys(%{$permissionflags})) {
         delete($env{"allowed.$allowtype"});
     }
 }