--- loncom/automation/Autocreate.pl 2010/02/22 03:44:21 1.12
+++ loncom/automation/Autocreate.pl 2011/03/07 02:10:40 1.19
@@ -2,7 +2,7 @@
#
# Automated Course Creation script
#
-# $Id: Autocreate.pl,v 1.12 2010/02/22 03:44:21 raeburn Exp $
+# $Id: Autocreate.pl,v 1.19 2011/03/07 02:10:40 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -110,16 +110,16 @@
close($fh);
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);
+ &unset_permissions(\%permissionflags);
+ &unset_dc_env();
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);
@@ -131,12 +131,12 @@
my $settings;
if (ref($domconfig{'autocreate'}) eq 'HASH') {
$settings = $domconfig{'autocreate'};
+ my ($dcname,$dcdom);
+ if ($settings->{'xmldc'}) {
+ ($dcname,$dcdom) = split(':',$settings->{'xmldc'});
+ }
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;
@@ -148,8 +148,12 @@
}
}
if ($settings->{'req'}) {
- my %domdefs = &Apache::lonnet::get_domain_defaults($dom);
- &process_official_reqs($fh,$dom,$reqsnamespace,\%longroles,\%domdefs);
+ &set_dc_env($dcname,$dcdom);
+ my $output = &Apache::loncoursequeueadmin::process_official_reqs('auto',$dom,$dcname,$dcdom);
+ &unset_dc_env();
+ if ($output) {
+ print $fh $output;
+ }
}
}
}
@@ -161,10 +165,7 @@
sub process_xml {
my ($fh,$dom,$dcname,$dcdom) = @_;
- $env{'user.name'} = $dcname;
- $env{'user.domain'} = $dcdom;
- $env{'request.role.domain'} = $dom;
-
+ &set_dc_env($dcname.$dcdom,$dom);
# Initialize language handler
&Apache::lonlocal::get_language_handle();
@@ -208,138 +209,18 @@ sub process_xml {
$output .= $newcourse.':';
}
$output =~ s/:$//;
- delete($env{'user.name'});
- delete($env{'user.domain'});
- delete($env{'request.role.domain'});
+ &unset_dc_env();
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 {
my ($dcdom,$dcname,$defdom) = @_;
- my %dumphash=
- &Apache::lonnet::dump('roles',$dcdom,$dcname);
- my $now=time;
- my $activedc = 0;
- 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;
- }
+ my %roleshash =
+ &Apache::lonnet::get_my_roles($dcname,$dcdom,'userroles',undef,['dc'],[$defdom]);
+ if (keys(%roleshash) > 0) {
+ return 1;
}
- return $activedc;
+ return 0;
}
sub set_permissions {
@@ -358,3 +239,24 @@ sub unset_permissions {
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;
+}