[BACK]Return to Autocreate.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / automation

Diff for /loncom/automation/Autocreate.pl between versions 1.10 and 1.12

version 1.10, 2008/03/18 20:51:12 version 1.12, 2010/02/22 03:44:21
Line 26 Line 26
 #  #
 # http://www.lon-capa.org/  # 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  # www /home/httpd/perl/Autocreate.pl $dom $uname:$udom
 #  #
 # where $dom is the name of the course domain, $uname and $udom are the   # where $dom is the name of the course domain, $uname and $udom are the
 # username and domain of a Domain Coordinator in the domain.     # 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 strict;
     use lib '/home/httpd/lib/perl';      use lib '/home/httpd/lib/perl';
     use Apache::lonnet;      use Apache::lonnet;
     use Apache::lonlocal;      use Apache::lonlocal;
       use Apache::loncoursequeueadmin;
     use LONCAPA::batchcreatecourse;      use LONCAPA::batchcreatecourse;
     use LONCAPA::Configuration;      use LONCAPA::Configuration;
       use LONCAPA();
   
     my $perlvarref = &LONCAPA::Configuration::read_conf('loncapa.conf');      my $perlvarref = &LONCAPA::Configuration::read_conf('loncapa.conf');
     my $logfile = $$perlvarref{'lonDaemons'}.'/logs/autocreate.log';      my $logfile = $$perlvarref{'lonDaemons'}.'/logs/autocreate.log';
     my @domains = &Apache::lonnet::current_machine_domains();      my @machinedoms = sort(&Apache::lonnet::current_machine_domains());
     open (my $fh,">>$logfile");      my @ids=&Apache::lonnet::current_machine_ids();
     print $fh "********************\n".localtime(time)." Autocreation messages start --\n";      my (@libids,@domains);
     if (@ARGV < 2) {      foreach my $id (@ids) {
         print $fh "usage: ./Autocreate <coursedomain  username:domain>.\nPlease provide the username and domain of a Domain Coordinator.\n";          if (&Apache::lonnet::is_library($id)) {
         exit;                push(@libids,$id);
     }          }
 # 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.      exit if (!@libids); 
     if (!&check_activedc($dcdom,$dcname,$defdom)) {      foreach my $dom (@machinedoms) {
         print $fh "The username you supplied for domain $defdom does not have an active domain coordinator role in the domain\n\n";          my $primary = &Apache::lonnet::domain($dom,'primary');
         close($fh);          if (grep(/^\Q$primary\E$/,@libids)) {
         exit;              unless (grep(/^\Q$dom\E$/,@domains)) {
                   push(@domains,$dom);
               }
           }
     }      }
       exit if (!@domains);
     # Initialize language handler      open (my $fh,">>$logfile");
     &Apache::lonlocal::get_language_handle();      print $fh "********************\n".localtime(time)." Autocreation messages start --\n";
   
     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');      my $wwwid=getpwnam('www');
     if ($wwwid!=$<) {      if ($wwwid!=$<) {
         my $emailto=$$perlvarref{'lonAdmEMail'};          my $emailto=$$perlvarref{'lonAdmEMail'};
         my $subj="LON: $$perlvarref{'lonHostID'} User ID mismatch";          my $subj="LON: $$perlvarref{'lonHostID'} User ID mismatch";
         my $requestmail = "To: $emailto\n";          my $requestmail = "To: $emailto\n";
         $requestmail .=           $requestmail .=
         "Subject: LON: $$perlvarref{'lonHostID'} User ID mismatch\n".          "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 ($emailto =~ /^[^\@]+\@[^\@]+$/) {
             if (open(MAIL, "|/usr/lib/sendmail -oi -t -odb")) {              if (open(MAIL, "|/usr/lib/sendmail -oi -t -odb")) {
                 print MAIL $requestmail;                  print MAIL $requestmail;
                 close(MAIL);                  close(MAIL);
                 print $fh "Autocreate.pl must be run as user www\n\n";                  print $fh "Autocreate.pl must be run as user www\n\n";
             } else {              } 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 {          } else {
             print $fh "Notification e-mail address for Administrator is not a valid e-mail address\n\n";              print $fh "Notification e-mail address for Administrator is not a valid e-mail address\n\n";
Line 100 Line 91
         close($fh);          close($fh);
         exit;          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";      # Initialize language handler
     my ($result,$logmsg) = &LONCAPA::batchcreatecourse::create_courses(\@requests,\%courseids,'auto',$defdom,$dcname,$dcdom);      &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;      my $outcome;
     if ($result ne '') {      if ($result ne '') {
         $outcome = $result."\n";          $outcome = $result."\n";
Line 130 Line 202
             }              }
         }          }
     }      }
       foreach my $key (sort(keys(%courseids))) {
     foreach my $key (sort keys %courseids) {  
         print $fh "created course: $key - $courseids{$key}\n";          print $fh "created course: $key - $courseids{$key}\n";
         my $newcourse = &Apache::lonnet::escape($key.':'.$courseids{$key});          my $newcourse = &LONCAPA::escape($key.':'.$courseids{$key});
         $output .= $newcourse.':';           $output .= $newcourse.':';
     }      }
     $output =~ s/:$//;      $output =~ s/:$//;
     print $output;  
   
     &unset_permissions(\%permissionflags);  
     delete($env{'user.name'});      delete($env{'user.name'});
     delete($env{'user.domain'});      delete($env{'user.domain'});
     delete($env{'request.role.domain'});      delete($env{'request.role.domain'});
     print $fh "-- ".localtime(time)." Autocreation messages end\n*******************\n\n";      return $output;
     close($fh);  }
   
   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 {  sub check_activedc {
     my ($dcdom,$dcname,$defdom) = @_;      my ($dcdom,$dcname,$defdom) = @_;
Line 170  sub set_permissions { Line 347  sub set_permissions {
     foreach my $allowtype (@{$permissions}) {      foreach my $allowtype (@{$permissions}) {
         unless($env{"allowed.$allowtype"}) {          unless($env{"allowed.$allowtype"}) {
             $env{"allowed.$allowtype"} = 'F';              $env{"allowed.$allowtype"} = 'F';
             $permissionflags{$allowtype} = 1;              $permissionflags->{$allowtype} = 1;
         }          }
     }      }
 }  }
   
 sub unset_permissions {  sub unset_permissions {
     my ($permissionflags) = @_;      my ($permissionflags) = @_;
     foreach my $allowtype (keys %{$permissionflags}) {      foreach my $allowtype (keys(%{$permissionflags})) {
         delete($env{"allowed.$allowtype"});          delete($env{"allowed.$allowtype"});
     }      }
 }  }
Removed from v.1.10  
changed lines
  Added in v.1.12

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>