Return to Autocreate.pl CVS log

Up to [LON-CAPA] / loncom / automation

- &escape() was moved from lonnet.pm to LONCAPA.pm some time ago.

    1: #!/usr/bin/perl
    2: #
    3: # Automated Course Creation script
    4: #
    5: # $Id: Autocreate.pl,v 1.11 2010/01/31 18:06:10 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. Call this from an entry in /etc/cron.d/loncapa
   30: #
   31: # www /home/httpd/perl/Autocreate.pl $dom $uname:$udom
   32: #
   33: # where $dom is the name of the course domain, $uname and $udom are the 
   34: # username and domain of a Domain Coordinator in the domain.   
   35: #
   36:     use strict;
   37:     use lib '/home/httpd/lib/perl';
   38:     use Apache::lonnet;
   39:     use Apache::lonlocal;
   40:     use LONCAPA::batchcreatecourse;
   41:     use LONCAPA::Configuration;
   42:     use LONCAPA();
   43: 
   44:     my $perlvarref = &LONCAPA::Configuration::read_conf('loncapa.conf');
   45:     my $logfile = $$perlvarref{'lonDaemons'}.'/logs/autocreate.log';
   46:     my @domains = &Apache::lonnet::current_machine_domains();
   47:     open (my $fh,">>$logfile");
   48:     print $fh "********************\n".localtime(time)." Autocreation messages start --\n";
   49:     if (@ARGV < 2) {
   50:         print $fh "usage: ./Autocreate <coursedomain  username:domain>.\nPlease provide the username and domain of a Domain Coordinator.\n";
   51:         exit;  
   52:     }
   53: # check if $defdom is a domain hosted on this library server. 
   54:     my $defdom = $ARGV[0];
   55:     my ($dcname,$dcdom) = ($ARGV[1] =~ /^([^:]+):([^:]+)$/);
   56:     if ($defdom eq '' || !grep/^$defdom$/,@domains) {
   57:         print $fh "The domain you supplied is not a valid domain for this server\n\n";
   58:         close($fh);
   59:         exit;
   60:     }
   61: # check if user is an active domain coordinator.
   62:     if (!&check_activedc($dcdom,$dcname,$defdom)) {
   63:         print $fh "The username you supplied for domain $defdom does not have an active domain coordinator role in the domain\n\n";
   64:         close($fh);
   65:         exit;
   66:     }
   67: 
   68:     # Initialize language handler
   69:     &Apache::lonlocal::get_language_handle();
   70: 
   71:     my $batchdir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$defdom.'/auto';
   72:     opendir(DIR,"$batchdir/pending");
   73:     my @requests = grep(!/^\.\.?$/,readdir(DIR));
   74:     closedir(DIR);
   75:     my %courseids = ();
   76:     my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst');
   77:     my %permissionflags = ();
   78:     &set_permissions(\%permissionflags,\@permissions);
   79:     $env{'user.name'} = $dcname;
   80:     $env{'user.domain'} = $dcdom;
   81:     $env{'request.role.domain'} = $defdom;
   82:     my $wwwid=getpwnam('www');
   83:     if ($wwwid!=$<) {
   84:         my $emailto=$$perlvarref{'lonAdmEMail'};
   85:         my $subj="LON: $$perlvarref{'lonHostID'} User ID mismatch";
   86:         my $requestmail = "To: $emailto\n";
   87:         $requestmail .= 
   88:         "Subject: LON: $$perlvarref{'lonHostID'} User ID mismatch\n".
   89:         "User ID mismatch. Autocreate.pl must be run as user www\n"; 
   90:         if ($emailto =~ /^[^\@]+\@[^\@]+$/) {
   91:             if (open(MAIL, "|/usr/lib/sendmail -oi -t -odb")) {
   92:                 print MAIL $requestmail;
   93:                 close(MAIL);
   94:                 print $fh "Autocreate.pl must be run as user www\n\n";
   95:             } else {
   96:                 print $fh "Could not send notification e-mail to $emailto\n\n"; 
   97:             }
   98:         } else {
   99:             print $fh "Notification e-mail address for Administrator is not a valid e-mail address\n\n";
  100:         }
  101:         close($fh);
  102:         exit;
  103:     }
  104: 
  105:     print $fh "Sending to batch - auto,$defdom,$dcname,$dcdom ".join(":",@requests)."\n";
  106:     my ($result,$logmsg) = &LONCAPA::batchcreatecourse::create_courses(\@requests,\%courseids,'auto',$defdom,$dcname,$dcdom);
  107:     my $outcome;
  108:     if ($result ne '') {
  109:         $outcome = $result."\n";
  110:     }
  111:     if ($logmsg ne '') {
  112:         $outcome .= $logmsg."\n";    
  113:     }
  114:     print $fh $outcome;
  115: 
  116:     my $output;
  117: # Copy requests from pending directory to processed directory and unlink.
  118:     foreach my $request (@requests) {  
  119:         if ((-e "$batchdir/pending/$request") && $request !~ /\.\./ && $request ne '' &&$request ne './') {
  120:             open(FILE,"<$batchdir/pending/$request");
  121:             my @buffer = <FILE>;
  122:             close(FILE);
  123:             if (!-e "$batchdir/processed") {
  124:                 mkdir("$batchdir/processed", 0755);
  125:             }
  126:             open(FILE,">$batchdir/processed/$request");
  127:             print FILE @buffer;
  128:             close(FILE);
  129:             if (-e "$batchdir/processed/$request") {
  130:                 unlink("$batchdir/pending/$request");
  131:             }
  132:         }
  133:     }
  134: 
  135:     foreach my $key (sort keys %courseids) {
  136:         print $fh "created course: $key - $courseids{$key}\n";
  137:         my $newcourse = &LONCAPA::escape($key.':'.$courseids{$key});
  138:         $output .= $newcourse.':'; 
  139:     }
  140:     $output =~ s/:$//;
  141:     print $output;
  142: 
  143:     &unset_permissions(\%permissionflags);
  144:     delete($env{'user.name'});
  145:     delete($env{'user.domain'});
  146:     delete($env{'request.role.domain'});
  147:     print $fh "-- ".localtime(time)." Autocreation messages end\n*******************\n\n";
  148:     close($fh);
  149: 
  150: sub check_activedc {
  151:     my ($dcdom,$dcname,$defdom) = @_;
  152:     my %dumphash=
  153:             &Apache::lonnet::dump('roles',$dcdom,$dcname);
  154:     my $now=time;
  155:     my $activedc = 0;
  156:     foreach my $item (keys %dumphash) {
  157:         my ($domain,$role) = ($item =~ m-^/([^/]+)/[^_]*_(\w+)$-);
  158:         if ($role eq 'dc' && $domain eq $defdom) {
  159:             my ($trole,$tend,$tstart)=split(/_/,$dumphash{$item});
  160:             if (($tend) && ($tend<$now)) { next; }
  161:             if (($tstart) && ($now<$tstart)) { next; }
  162:             $activedc = 1;
  163:             last;
  164:         }
  165:     }
  166:     return $activedc;
  167: }
  168: 
  169: sub set_permissions {
  170:     my ($permissionflags,$permissions) = @_;
  171:     foreach my $allowtype (@{$permissions}) {
  172:         unless($env{"allowed.$allowtype"}) {
  173:             $env{"allowed.$allowtype"} = 'F';
  174:             $permissionflags{$allowtype} = 1;
  175:         }
  176:     }
  177: }
  178: 
  179: sub unset_permissions {
  180:     my ($permissionflags) = @_;
  181:     foreach my $allowtype (keys %{$permissionflags}) {
  182:         delete($env{"allowed.$allowtype"});
  183:     }
  184: }