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

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

version 1.12, 2010/02/22 03:44:21 version 1.20, 2016/11/16 18:09:21
Line 110 Line 110
                 close($fh);                  close($fh);
                 exit;                  exit;
             }              }
               &set_dc_env($dcname,$dcdom,$defdom);
               my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst');
               my %permissionflags = ();
               &set_permissions(\%permissionflags,\@permissions);
             my $output = &process_xml($fh,$defdom,$dcname,$dcdom);              my $output = &process_xml($fh,$defdom,$dcname,$dcdom);
               &unset_permissions(\%permissionflags);
               &unset_dc_env();
             print $output;              print $output;
         }          }
     } else {      } 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 @permissions = ('mau','ccc','cin','cta','cep','ccr','cst');
         my %permissionflags = ();          my %permissionflags = ();
         &set_permissions(\%permissionflags,\@permissions);          &set_permissions(\%permissionflags,\@permissions);
Line 131 Line 131
             my $settings;              my $settings;
             if (ref($domconfig{'autocreate'}) eq 'HASH') {              if (ref($domconfig{'autocreate'}) eq 'HASH') {
                 $settings = $domconfig{'autocreate'};                  $settings = $domconfig{'autocreate'};
                   my ($dcname,$dcdom);
                   if ($settings->{'xmldc'}) {
                       ($dcname,$dcdom) = split(':',$settings->{'xmldc'});
                   }
                 if ($settings->{'xml'}) {                  if ($settings->{'xml'}) {
                     if ($settings->{'xmldc'}) {                      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)) {                          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";                              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;                              next;
Line 148 Line 148
                     }                      }
                 }                  }
                 if ($settings->{'req'}) {                  if ($settings->{'req'}) {
                     my %domdefs = &Apache::lonnet::get_domain_defaults($dom);                      &set_dc_env($dcname,$dcdom);
                     &process_official_reqs($fh,$dom,$reqsnamespace,\%longroles,\%domdefs);                      my $output = &Apache::loncoursequeueadmin::process_official_reqs('auto',$dom,$dcname,$dcdom);
                       &unset_dc_env();
                       if ($output) {
                           print $fh $output;
                       }
                 }                  }
             }              }
         }          }
Line 161 Line 165
   
 sub process_xml {  sub process_xml {
     my ($fh,$dom,$dcname,$dcdom) = @_;      my ($fh,$dom,$dcname,$dcdom) = @_;
     $env{'user.name'} = $dcname;      &set_dc_env($dcname,$dcdom,$dom);
     $env{'user.domain'} = $dcdom;  
     $env{'request.role.domain'} = $dom;  
   
     # Initialize language handler      # Initialize language handler
     &Apache::lonlocal::get_language_handle();      &Apache::lonlocal::get_language_handle();
   
Line 208  sub process_xml { Line 209  sub process_xml {
         $output .= $newcourse.':';          $output .= $newcourse.':';
     }      }
     $output =~ s/:$//;      $output =~ s/:$//;
     delete($env{'user.name'});      &unset_dc_env();
     delete($env{'user.domain'});  
     delete($env{'request.role.domain'});  
     return $output;      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 {  sub check_activedc {
     my ($dcdom,$dcname,$defdom) = @_;      my ($dcdom,$dcname,$defdom) = @_;
     my %dumphash=      my %roleshash = 
             &Apache::lonnet::dump('roles',$dcdom,$dcname);          &Apache::lonnet::get_my_roles($dcname,$dcdom,'userroles',undef,['dc'],[$defdom]);
     my $now=time;      if (keys(%roleshash) > 0) {
     my $activedc = 0;          return 1;
     foreach my $item (keys %dumphash) {  
         my ($domain,$role) = ($item =~ m-^/([^/]+)/[^_]*_(\w+)$-);  
         if ($role eq 'dc' && $domain eq $defdom) {  
             my ($trole,$tend,$tstart)=split(/_/,$dumphash{$item});  
             if (($tend) && ($tend<$now)) { next; }  
             if (($tstart) && ($now<$tstart)) { next; }  
             $activedc = 1;  
             last;  
         }  
     }      }
     return $activedc;      return 0;
 }  }
   
 sub set_permissions {  sub set_permissions {
Line 358  sub unset_permissions { Line 239  sub unset_permissions {
         delete($env{"allowed.$allowtype"});          delete($env{"allowed.$allowtype"});
     }      }
 }  }
   
   sub set_dc_env {
       my ($dcname,$dcdom,$defdom) = @_;
       $env{'user.name'} = $dcname;
       $env{'user.domain'} = $dcdom;
       $env{'user.home'} = &Apache::lonnet::homeserver($dcname,$dcdom);
       if ($defdom ne '') {
           $env{'request.role.domain'} = $defdom;
       } 
       return;
   }
   
   sub unset_dc_env {
       delete($env{'user.name'});
       delete($env{'user.domain'});
       delete($env{'user.home'});
       if ($env{'request.role.domain'}) {
           delete($env{'request.role.domain'});
       }
       return;
   }
Removed from v.1.12  
changed lines
  Added in v.1.20

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