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

Diff for /loncom/automation/Autocreate.pl between versions 1.11 and 1.14

version 1.11, 2010/01/31 18:06:10 version 1.14, 2010/08/13 16:37:30
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();      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 101 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;
               }
               $env{'user.name'} = $dcname;
               $env{'user.domain'} = $dcdom;
               $env{'request.role.domain'} = $defdom;
               my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst');
               my %permissionflags = ();
               &set_permissions(\%permissionflags,\@permissions);
               my $output = &process_xml($fh,$defdom,$dcname,$dcdom);
               print $output;
               &unset_permissions(\%permissionflags);
           }
       } else {
           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 $output = &Apache::process_official_reqs('auto',$dom);
                       if ($output) {
                           print $fh $output;
                       }
                   }
               }
           }
           &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 131 Line 205
             }              }
         }          }
     }      }
       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 = &LONCAPA::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 check_activedc {  sub check_activedc {
     my ($dcdom,$dcname,$defdom) = @_;      my ($dcdom,$dcname,$defdom) = @_;
Line 171  sub set_permissions { Line 241  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.11  
changed lines
  Added in v.1.14

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