Return to Autocreate.pl CVS log

Up to [LON-CAPA] / loncom / automation

Annotation of loncom/automation/Autocreate.pl, revision 1.1

1.1     ! raeburn     1: #!/usr/bin/perl
        !             2: #
        !             3: # Automated Course Creation script
        !             4: #
        !             5: # Copyright Michigan State University Board of Trustees
        !             6: #
        !             7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
        !             8: #
        !             9: # LON-CAPA is free software; you can redistribute it and/or modify
        !            10: # it under the terms of the GNU General Public License as published by
        !            11: # the Free Software Foundation; either version 2 of the License, or
        !            12: # (at your option) any later version.
        !            13: #
        !            14: # LON-CAPA is distributed in the hope that it will be useful,
        !            15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
        !            17: # GNU General Public License for more details.
        !            18: #
        !            19: # You should have received a copy of the GNU General Public License
        !            20: # along with LON-CAPA; if not, write to the Free Software
        !            21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
        !            22: #
        !            23: # /home/httpd/html/adm/gpl.txt
        !            24: #
        !            25: # http://www.lon-capa.org/
        !            26: #
        !            27: # Run as www. Call this from an entry in /etc/cron.d/loncapa
        !            28: #
        !            29: # www /home/httpd/perl/Autocreate.pl $dom $uname:$udom
        !            30: #
        !            31: # where $dom is the name of the course domain, $uname and $udom are the 
        !            32: # username and domain of a Domain Coordinator in the domain.   
        !            33: #
        !            34:     use strict;
        !            35:     use lib '/home/httpd/lib/perl';
        !            36:     use Apache::lonnet;
        !            37:     use LONCAPA::batchcreatecourse;
        !            38:     use LONCAPA::Configuration;
        !            39: 
        !            40:     my $perlvarref = &LONCAPA::Configuration::read_conf('loncapa.conf');
        !            41:     my $logfile = $$perlvarref{'lonDaemons'}.'/logs/autocreate.log';
        !            42:     my @domains = &Apache::lonnet::current_machine_domains();
        !            43:     open (my $fh,">>$logfile");
        !            44:     print $fh "********************\n".localtime(time)." Autocreation messages start --\n";
        !            45:     if (@ARGV < 2) {
        !            46:         print $fh "usage: ./Autocreate <coursedomain  username:domain>.\nPlease provide the username and domain of a Domain Coordinator.\n";
        !            47:         exit;  
        !            48:     }
        !            49: # check if $defdom is a domain hosted on this library server. 
        !            50:     my $defdom = $ARGV[0];
        !            51:     my ($dcname,$dcdom) = ($ARGV[1] =~ /^([^:]+):([^:]+)$/);
        !            52:     if ($defdom eq '' || !grep/^$defdom$/,@domains) {
        !            53:         print $fh "The domain you supplied is not a valid domain for this server\n\n";
        !            54:         close($fh);
        !            55:         exit;
        !            56:     }
        !            57: # check if user is an active domain coordinator.
        !            58:     if (!&check_activedc($dcdom,$dcname,$defdom)) {
        !            59:         print $fh "The username you supplied for domain $defdom does not have an active domain coordinator role in the domain\n\n";
        !            60:         close($fh);
        !            61:         exit;
        !            62:     }
        !            63:                                                    
        !            64:     my $batchdir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$defdom.'/auto';
        !            65:     opendir(DIR,"$batchdir/pending");
        !            66:     my @requests = grep(!/^\.\.?$/,readdir(DIR));
        !            67:     closedir(DIR);
        !            68:     my %courseids = ();
        !            69:     my $cccflag = 0;
        !            70:     unless ($ENV{'allowed.ccc'}) {
        !            71:         $ENV{'allowed.ccc'} = 'F';
        !            72:         $cccflag = 1;
        !            73:     }
        !            74:     my $wwwid=getpwnam('www');
        !            75:     if ($wwwid!=$<) {
        !            76:         my $emailto=$$perlvarref{'lonAdmEMail'};
        !            77:         my $subj="LON: $$perlvarref{'lonHostID'} User ID mismatch";
        !            78:         my $requestmail = "To: $emailto\n";
        !            79:         $requestmail .= 
        !            80:         "Subject: LON: $$perlvarref{'lonHostID'} User ID mismatch\n".
        !            81:         "User ID mismatch. Autocreate.pl must be run as user www\n"; 
        !            82:         if ($emailto =~ /^[^\@]+\@[^\@]+$/) {
        !            83:             if (open(MAIL, "|/usr/lib/sendmail -oi -t -odb")) {
        !            84:                 print MAIL $requestmail;
        !            85:                 close(MAIL);
        !            86:                 print $fh "Autocreate.pl must be run as user www\n\n";
        !            87:             } else {
        !            88:                 print $fh "Could not send notification e-mail to $emailto\n\n"; 
        !            89:             }
        !            90:         } else {
        !            91:             print $fh "Notification e-mail address for Administrator is not a valid e-mail address\n\n";
        !            92:         }
        !            93:         close($fh);
        !            94:         exit;
        !            95:     }
        !            96: 
        !            97:     my ($output,$logmsg) = &LONCAPA::batchcreatecourse::create_courses(\@requests,\%courseids,'auto',$defdom,$dcname,$dcdom);
        !            98: 
        !            99: # Copy requests from pending directory to processed directory and unlink.
        !           100:   foreach my $request (@requests) {  
        !           101:         if ((-e "$batchdir/pending/$request") && $request !~ /\.\./ && $request ne '' &&$request ne './') {
        !           102:             open(FILE,"<$batchdir/pending/$request");
        !           103:             my @buffer = <FILE>;
        !           104:             close(FILE);
        !           105:             open(FILE,">$batchdir/processed/$request");
        !           106:             print FILE @buffer;
        !           107:             close(FILE);
        !           108:             if (-e "$batchdir/processed/$request") {
        !           109:                 unlink("$batchdir/pending/$request");
        !           110:             }
        !           111:         }
        !           112:     }
        !           113: 
        !           114:     foreach my $key (sort keys %courseids) {
        !           115:         print $fh "created course: $key\n";
        !           116:     }
        !           117: 
        !           118:     if ($cccflag) {
        !           119:         delete($ENV{'allowed.ccc'});
        !           120:     }
        !           121:     print $fh "-- ".localtime(time)." Autocreation messages end\n*******************\n\n";
        !           122:     close($fh);
        !           123: 
        !           124: sub check_activedc {
        !           125:     my ($dcdom,$dcname,$defdom) = @_;
        !           126:     my %dumphash=
        !           127:             &Apache::lonnet::dump('roles',$dcdom,$dcname);
        !           128:     my $now=time;
        !           129:     my $activedc = 0;
        !           130:     foreach my $item (keys %dumphash) {
        !           131:         my ($domain,$role) = ($item =~ m-^/([^/]+)/[^_]*_(\w+)$-);
        !           132:         if ($role eq 'dc' && $domain eq $defdom) {
        !           133:             my ($trole,$tend,$tstart)=split(/_/,$dumphash{$item});
        !           134:             if (($tend) && ($tend<$now)) { next; }
        !           135:             if (($tstart) && ($now<$tstart)) { next; }
        !           136:             $activedc = 1;
        !           137:             last;
        !           138:         }
        !           139:     }
        !           140:     return $activedc;
        !           141: }