--- loncom/interface/loncoursequeueadmin.pm 2009/08/16 19:16:16 1.2 +++ loncom/interface/loncoursequeueadmin.pm 2009/10/04 16:07:11 1.9.2.2 @@ -1,7 +1,7 @@ # The LearningOnline Network # Utilities to administer domain course requests and course self-enroll requests # -# $Id: loncoursequeueadmin.pm,v 1.2 2009/08/16 19:16:16 raeburn Exp $ +# $Id: loncoursequeueadmin.pm,v 1.9.2.2 2009/10/04 16:07:11 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -77,13 +77,13 @@ sub send_selfserve_notification { $rawsubj = 'Self-enrollment requests processed'; push(@rawmsg,{ mt => 'Enrollment requests in the following course: [_1]have been processed.', - args => ["\n $contextdesc\n"], + args => ["\n $contextdesc"], }); } elsif ($context eq 'domainmanagers') { $rawsubj = 'Course requests reviewed'; push(@rawmsg,{ mt => 'Course creation requests in the following domain: [_1]have been reviewed.', - args => ["\n $contextdesc\n"], + args => ["\n $contextdesc"], }); if (ref($textstr) eq 'ARRAY') { push(@rawmsg,@{$textstr}); @@ -220,7 +220,7 @@ sub display_queued_requests { } else { $formaction = '/adm/createcourse'; $namespace = 'courserequestqueue'; - %requesthash = &Apache::lonnet::dump_dom($namespace,$dom,undef,'_approval'); + %requesthash = &Apache::lonnet::dump_dom($namespace,$dom,'_approval'); $nextelement = ''; } my ($output,%queue_by_date,%crstypes); @@ -293,8 +293,8 @@ sub display_queued_requests { } else { my ($cnum,$ownername,$ownerdom,$type,$cdesc)=split(/:/,$request,5); - $detailslink=''.$cdesc.''; + $detailslink=''.$cdesc.''; $crstype = $type; if (defined($crstypes{$type})) { $crstype = $crstypes{$type}; @@ -345,7 +345,8 @@ sub update_request_queue { $domdesc,$now,$sender,$approvedmsg,$rejectedmsg,$beneficiary, @existing,@missingreq,@invalidusers,@limitexceeded,@completed, @processing_errors,@warn_approves,@warn_rejects,@approvals, - @rejections,%courseroles,%communityroles,%domdefs); + @rejections,@rejectionerrors,@nopermissions,%courseroles, + %communityroles,%domdefs,@warn_coursereqs); @approvals = &Apache::loncommon::get_env_multiple('form.approvereq'); @rejections = &Apache::loncommon::get_env_multiple('form.rejectreq'); $now = time; @@ -379,7 +380,7 @@ sub update_request_queue { $domdesc = &Apache::lonnet::domain($cdom); $namespace = 'courserequestqueue'; $beneficiary = 'courserequestor'; - %requesthash = &Apache::lonnet::dump_dom($namespace,$cdom,undef,'_approval'); + %requesthash = &Apache::lonnet::dump_dom($namespace,$cdom,'_approval'); my $chome = &Apache::lonnet::domain($cdom,'primary'); $hostname = &Apache::lonnet::hostname($chome); $protocol = $Apache::lonnet::protocol{$chome}; @@ -462,6 +463,15 @@ sub update_request_queue { &Apache::lonnet::put($namespace,\%userrequest,$udom,$uname); if ($userresult ne 'ok') { push(@warn_approves,$uname.':'.$udom); + } elsif ($udom eq 'gci') { + my %changehash = ( + 'reqcrsotherdom.unofficial' => 'gcitest:autolimit=', + ); + my $reqresult = &Apache::lonnet::put('environment',\%changehash, + $udom,$uname); + if ($reqresult ne 'ok') { + push(@warn_coursereqs,$uname.':'.$udom); + } } } else { push(@processing_errors,$uname.':'.$udom); @@ -482,8 +492,22 @@ sub update_request_queue { if ($crstype eq 'community') { $longroles = \%communityroles; } - if (&Apache::lonnet::usertools_access($ownername,$ownerdom,$crstype, - undef,'requestcourses')) { + my $cancreate; + if ($cdom eq $ownerdom) { + if (&Apache::lonnet::usertools_access($ownername,$ownerdom,$crstype, + undef,'requestcourses')) { + $cancreate = 1; + } + } else { + my %userenv = &Apache::lonnet::userenvironment($ownerdom,$ownername,'reqcrsotherdom.'.$crstype); + if ($userenv{'reqcrsotherdom.'.$crstype}) { + my @doms = split(',',$userenv{'reqcrsotherdom.'.$crstype}); + if (grep(/^\Q$cdom\E:/,@doms)) { + $cancreate = 1; + } + } + } + if ($cancreate) { my $requestkey = $cdom.'_'.$cnum; my %history = &Apache::lonnet::restore($requestkey,'courserequests', @@ -531,7 +555,7 @@ sub update_request_queue { push(@processing_errors,$cnum); } } else { - push(@processing_errors,$cnum); + push(@nopermissions,$cnum); } } else { push(@existing,$cnum); @@ -546,8 +570,9 @@ sub update_request_queue { @changes = map {$_.'_approval'} (@changes); } if (@rejections) { - foreach my $user (@rejections) { + foreach my $item (@rejections) { if ($context eq 'course') { + my $user = $item; &send_selfserve_notification($user,$rejectedmsg,$cid,$coursedesc, $now,$beneficiary,$sender); my ($uname,$udom) = split(/:/,$user); @@ -564,8 +589,10 @@ sub update_request_queue { push(@warn_rejects,$user); } } else { - if (ref($requesthash{$user.'_approval'}) eq 'HASH') { - if (&Apache::lonnet::homeserver($user,$cdom) eq 'no_host') { + my $cnum = $item; + if (ref($requesthash{$cnum.'_approval'}) eq 'HASH') { + if (&Apache::lonnet::homeserver($cnum,$cdom) eq 'no_host') { + my $requestkey = $cdom.'_'.$cnum; my $ownername = $requesthash{$cnum.'_approval'}{'ownername'}; my $ownerdom = $requesthash{$cnum.'_approval'}{'ownerdom'}; my $coursedesc = $requesthash{$cnum.'_approval'}{'description'}; @@ -573,7 +600,7 @@ sub update_request_queue { $cid,$coursedesc,$now,$beneficiary, $sender); my %history = - &Apache::lonnet::restore($cdom.'_'.$cnum,'courserequests', + &Apache::lonnet::restore($requestkey,'courserequests', $ownerdom,$ownername); if ((ref($history{'details'}) eq 'HASH') && ($history{'disposition'} eq 'approval')) { @@ -586,12 +613,29 @@ sub update_request_queue { adjudicator => $env{'user.name'}.':'.$env{'user.domain'}, ); my $userresult = - &Apache::lonnet::store_userdata($namespace,\%reqhash,$ownerdom,$ownername); - if ($userresult ne 'ok') { - push(@warn_rejects,$user); + &Apache::lonnet::store_userdata(\%reqhash,$requestkey, + 'courserequests',$ownerdom,$ownername); + if ($userresult eq 'ok') { + my %status = ( + 'status:'.$cdom.':'.$cnum => 'rejected' + ); + my $statusresult = + &Apache::lonnet::put('courserequests',\%status, + $ownerdom,$ownername); + if ($statusresult ne 'ok') { + push(@warn_rejects,$cnum); + } + } else { + push(@warn_rejects,$cnum); } + } else { + push(@warn_rejects,$cnum); } + } else { + push(@existing,$cnum); } + } else { + push(@rejectionerrors,$cnum); } } } @@ -729,6 +773,19 @@ sub update_request_queue { $output .= '

'; } } + if (@nopermissions) { + $output .= '

'.&mt('The following course creation requests could not be processed because the course owner does hot have rights to create this type of course:').'

'; + } if (@processing_errors) { if ($context eq 'course') { $output .= '

'.&mt('The following enrollment requests could not be processed because an error occurred:').'

'; } } + if (@rejectionerrors) { + $output .= '

'.&mt('The following course creation request rejections could not be fully processed because an error occurred:').'

'; + } if (@warn_approves || @warn_rejects) { if ($context eq 'course') { $output .= '

'.&mt("For the following users, an error occurred when updating the user's own self-enroll requests record:").'

'; } } + if (@warn_coursereqs) { + $output .= '

'..&mt("For the following users, an error occurred when setting rights to request creation of Concept Test courses:").'

'; + } return $output; } @@ -818,7 +895,7 @@ sub course_creation { $owneremail = $emails{$email}; last if ($owneremail ne ''); } - my %reqdetails = &build_batchcreatehash($dom,$details,$owneremail,$domdefs); + my %reqdetails = &build_batchcreatehash($dom,$context,$details,$owneremail,$domdefs); my $cid = &LONCAPA::batchcreatecourse::build_course($dom,$cnum,'requestcourses', \%reqdetails,$longroles,\$logmsg,\$newusermsg,\$addresult, \$enrollcount,\$output,\$keysmsg,$ownerdom,$ownername,$cnum,$crstype); @@ -831,7 +908,7 @@ sub course_creation { } sub build_batchcreatehash { - my ($dom,$details,$owneremail,$domdefs) = @_; + my ($dom,$context,$details,$owneremail,$domdefs) = @_; my %batchhash; my @items = qw{owner domain coursehome clonecrs clonedom datemode dateshift enrollstart enrollend accessstart accessend sections crosslists users}; if ((ref($details) eq 'HASH') && (ref($domdefs) eq 'HASH')) { @@ -852,14 +929,70 @@ sub build_batchcreatehash { } else { $batchhash{'crstype'} = 'Course'; } - $batchhash{'users'}{$details->{$owner}} = { - firstname => $env{'environment.first'}, - lastname => $env{'environment.last'}, - emailenc => $emailenc, - email => $owneremail, - }; + my ($owner_firstname,$owner_lastname); + if ($context eq 'domain') { + my %userenv = &Apache::lonnet::userenvironment($details->{'domain'}, + $details->{'owner'}, + 'firstname','lastname'); + $owner_firstname = $userenv{'firstname'}; + $owner_lastname = $userenv{'lastname'}; + } else { + $owner_firstname = $env{'environment.firstname'}; + $owner_lastname = $env{'environment.lastname'}; + } + if (ref($details->{'personnel'}) eq 'HASH') { + %{$batchhash{'users'}} = %{$details->{'personnel'}}; + if (ref($batchhash{'users'}) eq 'HASH') { + foreach my $userkey (keys(%{$batchhash{'users'}})) { + if (ref($batchhash{'users'}{$userkey}) eq 'HASH') { + if (ref($batchhash{'users'}{$userkey}{'roles'}) eq 'ARRAY') { + foreach my $role (@{$batchhash{'users'}{$userkey}{'roles'}}) { + my $start = ''; + my $end = ''; + if ($role eq 'st') { + $start = $details->{'accessstart'}; + $end = $details->{'accessend'}; + } + $batchhash{'users'}{$userkey}{$role}{'start'} = $start; + $batchhash{'users'}{$userkey}{$role}{'end'} = $end; + } + } + } + } + } + } + $batchhash{'users'}{$owner}{firstname} = $owner_firstname; + $batchhash{'users'}{$owner}{lastname} = $owner_lastname; + $batchhash{'users'}{$owner}{emailenc} = $emailenc; + $batchhash{'users'}{$owner}{owneremail} = $owneremail; } return %batchhash; } +sub can_clone_course { + my ($uname,$udom,$clonecrs,$clonedom) = @_; + my $canclone; + my %roleshash = &Apache::lonnet::get_my_roles($uname,$udom,'userroles',['active'], + ['cc'],[$clonedom]); + if (exists($roleshash{$clonecrs.':'.$clonedom.':cc'})) { + $canclone = 1; + } else { + my %courseenv = &Apache::lonnet::userenvironment($clonedom,$clonecrs,('cloners')); + my $cloners = $courseenv{'cloners'}; + if ($cloners ne '') { + my @cloneable = split(',',$cloners); + if (grep(/^\*$/,@cloneable)) { + $canclone = 1; + } + if (grep(/^\*:\Q$udom\E$/,@cloneable)) { + $canclone = 1; + } + if (grep(/^\Q$uname\E:\Q$udom\E$/,@cloneable)) { + $canclone = 1; + } + } + } + return $canclone; +} + 1;