--- loncom/interface/loncoursequeueadmin.pm 2014/05/06 20:42:27 1.48
+++ loncom/interface/loncoursequeueadmin.pm 2024/07/02 13:55:53 1.52.2.6
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Utilities to administer domain course requests and course self-enroll requests
#
-# $Id: loncoursequeueadmin.pm,v 1.48 2014/05/06 20:42:27 raeburn Exp $
+# $Id: loncoursequeueadmin.pm,v 1.52.2.6 2024/07/02 13:55:53 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -105,13 +105,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"],
+ args => ["\n$contextdesc\n"],
});
} elsif ($context eq 'domainmanagers') {
$rawsubj = 'Course/Community requests reviewed';
push(@rawmsg,{
- mt => 'Course/Community creation requests in the following domain: "[_1]" have been reviewed.',
- args => ["\n$contextdesc"],
+ mt => 'Course/Community creation requests in the following domain: [_1] have been reviewed.',
+ args => ["\n$contextdesc\n"],
});
if (ref($textstr) eq 'ARRAY') {
push(@rawmsg,@{$textstr});
@@ -119,8 +119,8 @@ sub send_selfserve_notification {
} elsif ($context eq 'authormanagers') {
$rawsubj = 'Authoring Space requests reviewed';
push(@rawmsg,{
- mt => 'Authoring requests in the following domain: "[_1]" have been reviewed.',
- args => ["\n$contextdesc"],
+ mt => 'Authoring requests in the following domain: [_1] have been reviewed.',
+ args => ["\n$contextdesc\n"],
});
if (ref($textstr) eq 'ARRAY') {
push(@rawmsg,@{$textstr});
@@ -128,8 +128,8 @@ sub send_selfserve_notification {
} elsif ($context eq 'usernamemanagers') {
$rawsubj = 'LON-CAPA account requests reviewed';
push(@rawmsg,{
- mt => 'Account requests in the following domain: "[_1]" have been reviewed.',
- args => ["\n$contextdesc"],
+ mt => 'Account requests in the following domain: [_1] have been reviewed.',
+ args => ["\n$contextdesc\n"],
});
if (ref($textstr) eq 'ARRAY') {
push(@rawmsg,@{$textstr});
@@ -396,6 +396,8 @@ sub display_queued_requests {
if ($context eq 'pending') {
$disposition = 'pending';
$nextphase = 'requestvalidation';
+ } elsif ($context eq 'displaypending') {
+ $disposition = 'pending';
}
%requesthash = &Apache::lonnet::dump_dom($namespace,$dom,'_'.$disposition);
$nextelement = ' ';
@@ -422,7 +424,7 @@ sub display_queued_requests {
my ($cnum,$disposition) = split('_',$item);
$entry = $cnum.':'.$requesthash{$item}{'ownername'}.':'.
$requesthash{$item}{'ownerdom'}.':';
- if ($context eq 'pending') {
+ if (($context eq 'pending') || ($context eq 'displaypending')) {
$entry .= $requesthash{$item}{'instcode'};
} else {
$entry .= $requesthash{$item}{'crstype'};
@@ -441,10 +443,12 @@ sub display_queued_requests {
if (keys(%queue_by_date) > 0) {
if ($context eq 'course') {
$output .= '
'.&mt('Self-enrollment requests queued pending approval by a Coordinator').' ';
- } elsif ($context eq 'pending') {
+ } elsif (($context eq 'pending') || ($context eq 'displaypending')) {
$output .= ''.&mt('Requests for official courses queued pending validation').' '.
''.&mt('Requests are validated against institutional data to confirm that the requestor is an instructor of record.').' '.
- &mt('Validation is attempted when the request is submitted.').' '.&mt('If unvalidated, the request will be held in a queue.').' '.&mt('Validation of pending requests is automatically repeated daily.').'
';
+ &mt('Validation is attempted when the request is submitted.').' '.
+ &mt('If unvalidated, the request will be held in a queue.').' '.
+ &mt('Validation of pending requests is automatically repeated daily.').'';
} elsif ($context eq 'requestauthor') {
$output .= ''.&mt('Requests for Authoring Space queued pending approval by a Domain Coordinator').' ';
} elsif ($context eq 'requestusername') {
@@ -472,8 +476,9 @@ sub display_queued_requests {
if ($context eq 'pending') {
$output .= ' '."\n".
- ''.&mt('Any course/community requests which are successfully validated will be created immediately.').' '.&mt('Unvalidated requests will be listed for manual approval/rejection.').'
';
- } else {
+ ''.&mt('Any course/community requests which are successfully validated will be created immediately.').' '.
+ &mt('Unvalidated requests will be listed for manual approval/rejection.').'
';
+ } elsif (($context ne 'helpdesk') && ($context ne 'displaypending')) {
$output .= ' ';
}
$output .= '';
@@ -481,7 +486,7 @@ sub display_queued_requests {
$output .= '';
if ($context eq 'course') {
$output .= &mt('There are currently no enrollment requests awaiting approval.');
- } elsif ($context eq 'pending') {
+ } elsif (($context eq 'pending') || ($context eq 'displaypending')) {
$output .= &mt('There are currently no requests for official courses awaiting validation.');
} elsif ($context eq 'requestauthor') {
$output .= &mt('There are currently no requests for Authoring Space awaiting approval.');
@@ -501,7 +506,7 @@ sub build_queue_display {
my %crstypes;
my $output = &Apache::loncommon::start_data_table().
&Apache::loncommon::start_data_table_header_row();
- unless ($context eq 'pending') {
+ unless (($context eq 'pending') || ($context eq 'displaypending') || ($context eq 'helpdesk')) {
$output .= '
'.&mt('Action').' ';
}
$output .= ''.&mt('Requestor').' ';
@@ -513,7 +518,7 @@ sub build_queue_display {
} elsif ($context eq 'requestusername') {
$output .= ''.&mt('Date requested').' '.
''.&mt('Details').' ';
- } elsif ($context eq 'pending' || $context eq 'stillpending') {
+ } elsif ($context eq 'pending' || $context eq 'displaypending' || $context eq 'stillpending') {
$output .= ''.&mt('Institutional code').' '.
''.&mt('Date requested').' '.
''.&mt('Details').' ';
@@ -568,7 +573,7 @@ sub build_queue_display {
} else {
my ($cnum,$ownername,$ownerdom,$type,$cdesc);
my $queued = 'approval';
- if ($context eq 'pending' || $context eq 'stillpending') {
+ if ($context eq 'pending' || $context eq 'displaypending' || $context eq 'stillpending') {
($cnum,$ownername,$ownerdom,$instcode,$cdesc)=split(/:/,$request,5);
$queued = 'pending';
} else {
@@ -586,7 +591,7 @@ sub build_queue_display {
&Apache::loncommon::plainname($ownername,$ownerdom),
$ownername,$ownerdom);
}
- unless ($context eq 'pending') {
+ unless (($context eq 'pending') || ($context eq 'displaypending') || ($context eq 'helpdesk')) {
$row = ''.
' '.&mt('Approve').' '.
''.(' 'x2).
@@ -604,8 +609,8 @@ sub build_queue_display {
} elsif ($context eq 'requestusername') {
$row .= ''.$showtime.' '."\n".
''.$detailslink.' '."\n";
- } else {
- if ($context eq 'pending' || $context eq 'stillpending') {
+ } else {
+ if ($context eq 'pending' || $context eq 'displaypending' || $context eq 'stillpending') {
$row .= ''.$instcode.' '."\n";
} else {
$row .= ''.$crstype.' '."\n";
@@ -874,10 +879,10 @@ sub update_request_queue {
my $dbname = 'nohist_requestedusernames';
my $domconfiguser = &Apache::lonnet::get_domainconfiguser($cdom);
my %curr = &Apache::lonnet::get($dbname,[$uname],$cdom,$domconfiguser);
-
+
if (ref($curr{$uname}) eq 'HASH') {
- my ($username,$logtoken,$serverid,$encpass,$courseid,$id,$firstname,
- $middlename,$lastname,$generation,$inststatus);
+ my ($logtoken,$serverid,$encpass,$courseid,$id,$firstname,
+ $middlename,$lastname,$generation,$inststatus,$email);
$curr{$uname}{'timestamp'} = $now;
$curr{$uname}{'adjudicator'} = $env{'user.name'}.':'.$env{'user.domain'};
$courseid = $curr{$uname}{'courseid'};
@@ -888,14 +893,35 @@ sub update_request_queue {
$generation = $curr{$uname}{'generation'};
$inststatus = $curr{$uname}{'inststatus'};
- my ($key,$caller)=split(/&/,$curr{$uname}{'tmpinfo'});
- if ($caller eq 'createaccount') {
- my $upass = &Apache::loncommon::des_decrypt($key,$curr{$uname}{'upass'});
+ if ($curr{$uname}{'email'} ne '') {
+ $email = $curr{$uname}{'email'};
+ } elsif ($uname =~ /^[^\@]+\@[^\@]+$/) {
+ $email = $uname;
+ }
+
+ my $upass;
+ if ($curr{$uname}{'tmpinfo'}) {
+ my ($key,$caller)=split(/&/,$curr{$uname}{'tmpinfo'});
+ if ($caller eq 'createaccount') {
+ if ($curr{$uname}{'upass'} eq '') {
+ $upass = $curr{$uname}{'upass'};
+ } else {
+ $upass = &Apache::loncommon::des_decrypt($key,$curr{$uname}{'upass'});
+ }
+ } else {
+ push(@processing_errors,$uname);
+ }
+ } else {
+ $upass = $curr{$uname}{'upass'};
+ }
+ if ($upass eq '') {
+ push(@processing_errors,$uname);
+ } else {
undef($curr{$uname}{'upass'});
my $result =
&Apache::lonnet::modifyuser($cdom,$uname,$id,'internal',$upass,
$firstname,$middlename,$lastname,
- $generation,undef,undef,$uname);
+ $generation,undef,undef,$email);
if ($result eq 'ok') {
$curr{$uname}{'status'} = 'created';
push(@completed,$uname);
@@ -916,8 +942,6 @@ sub update_request_queue {
} else {
push(@processing_errors,$uname);
}
- } else {
- push(@processing_errors,$uname);
}
} else {
push(@invalidusers,$uname);
@@ -968,6 +992,9 @@ sub update_request_queue {
}
}
}
+ if ($history{'details'}{'clonecrs'}) {
+ $customitems{'_LC_clonefrom'} = $history{'details'}{'clonedom'}.'_'.$history{'details'}{'clonecrs'};
+ }
my ($result,$postprocess) = &course_creation($cdom,$cnum,$context,$history{'details'},\$logmsg,
\$newusermsg,\$addresult,\$enrollcount,
\$response,\$keysmsg,\%domdefs,$longroles,\$code,\%customitems);
@@ -1311,7 +1338,7 @@ sub update_request_queue {
my $syllabuslink =
&Apache::loncommon::syllabuswrapper($showcourse,$cnum,$cdom);
if ($codes{$cnum}) {
- $syllabuslink .= &mt('Unique code: [_1]',$codes{$cnum});
+ $syllabuslink .= ' '.&mt('Unique code: [_1]',$codes{$cnum});
}
$output .= ''.$syllabuslink.' ';
}
@@ -1600,14 +1627,14 @@ sub course_creation {
$keysmsg,$domdefs,$longroles,$coderef,$customhash) = @_;
unless ((ref($details) eq 'HASH') && (ref($domdefs) eq 'HASH') &&
(ref($longroles) eq 'HASH')) {
- return 'error: Invalid request';
+ return ('error: Invalid request');
}
- my ($result,$ownername,$ownerdom);
+ my ($result,$ownername,$ownerdom,$autocoowner);
my $crstype = $details->{'crstype'};
my $coursedesc = $details->{'cdescr'};
my $accessstart = $details->{'accessstart'};
my $accessend = $details->{'accessend'};
- my %domconfig = &Apache::lonnet::get_dom('configuration',['requestcourses'],$dom);
+ my %domconfig = &Apache::lonnet::get_dom('configuration',['requestcourses','autoenroll'],$dom);
if (ref($domconfig{'requestcourses'}) eq 'HASH') {
if (ref($domconfig{'requestcourses'}{'uniquecode'}) eq 'HASH') {
if ($domconfig{'requestcourses'}{'uniquecode'}{$crstype}) {
@@ -1615,6 +1642,9 @@ sub course_creation {
}
}
}
+ if (ref($domconfig{'autoenroll'}) eq 'HASH') {
+ $autocoowner = $domconfig{'autoenroll'}{'co-owners'};
+ }
if ($context eq 'domain') {
$ownername = $details->{'owner'};
$ownerdom = $details->{'domain'};
@@ -1629,7 +1659,7 @@ sub course_creation {
$owneremail = $emails{$email};
last if ($owneremail ne '');
}
- my %reqdetails = &build_batchcreatehash($dom,$context,$details,$owneremail,$domdefs);
+ my %reqdetails = &build_batchcreatehash($dom,$cnum,$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,$coderef);
@@ -1643,6 +1673,66 @@ sub course_creation {
$postprocess = &Apache::lonnet::auto_crsreq_update($dom,$cnum,$crstype,$result,$ownername,
$ownerdom,$fullname,$coursedesc,$code,
$accessstart,$accessend,$customhash);
+ if ($autocoowner) {
+ my $instcode = $details->{'instcode'};
+ if (($instcode ne '') && (ref($reqdetails{'users'}) eq 'HASH')) {
+ my @posscoowners;
+ my $now = time;
+ foreach my $person (keys(%{$reqdetails{'users'}})) {
+ my ($uname,$udom) = split(/:/,$person);
+ next if (($udom ne $dom) || (($uname eq $ownername) && ($udom eq $ownerdom)));
+ if ((&Apache::lonnet::homeserver($uname,$udom,1) ne 'no_host') &&
+ (ref($reqdetails{'users'}{$person}) eq 'HASH')) {
+ if ((grep(/^cc$/,keys(%{$reqdetails{'users'}{$person}}))) &&
+ (ref($reqdetails{'users'}{$person}{'cc'}) eq 'HASH')) {
+ my $start = $reqdetails{'users'}{$person}{'cc'}{'start'};
+ my $end = $reqdetails{'users'}{$person}{'cc'}{'end'};
+ if ((($start eq '') || ($start <= $now)) &&
+ (($end eq '') || ($end >= $now))) {
+ push(@posscoowners,$person);
+ }
+ }
+ }
+ }
+ my @coowners;
+ if (@posscoowners) {
+ foreach my $user (@posscoowners) {
+ my ($checkcc,$desc) =
+ &Apache::lonnet::auto_validate_instcode($cnum,$dom,$instcode,$user);
+ unless ($checkcc eq 'valid') {
+ if (ref($reqdetails{'crosslists'}) eq 'HASH') {
+ foreach my $key (keys(%{$reqdetails{'crosslists'}})) {
+ if (ref($reqdetails{'crosslists'}{$key}) eq 'HASH') {
+ my $inst_crosslist = $reqdetails{'crosslists'}{$key}{'inst'};
+ if ($inst_crosslist ne '') {
+ $checkcc =
+ &Apache::lonnet::auto_validate_inst_crosslist($cnum,$dom,$instcode,
+ $inst_crosslist,$user);
+ last if ($checkcc eq 'valid');
+ }
+ }
+ }
+ }
+ }
+ if ($checkcc eq 'valid') {
+ if (@coowners > 0) {
+ unless (grep(/^\Q$user\E$/,@coowners)) {
+ push(@coowners,$user);
+ }
+ } else {
+ push(@coowners,$user);
+ }
+ }
+ }
+ }
+ if (@coowners > 0) {
+ my $chome = &Apache::lonnet::homeserver($cnum,$dom);
+ unless ($chome eq 'no_host') {
+ &Apache::lonnet::store_coowners($dom,$cnum,$chome,'',@coowners);
+ }
+ }
+ }
+ }
} else {
$result = 'error: '.$cid;
}
@@ -1650,15 +1740,30 @@ sub course_creation {
}
sub build_batchcreatehash {
- my ($dom,$context,$details,$owneremail,$domdefs) = @_;
+ my ($dom,$cnum,$context,$details,$owneremail,$domdefs) = @_;
my %batchhash;
- my @items = qw{owner domain coursehome clonecrs clonedom datemode dateshift enrollstart enrollend accessstart accessend sections crosslists users uniquecode};
+ my @items = qw{owner domain coursehome clonecrs clonedom datemode dateshift enrollstart enrollend accessstart accessend sections users uniquecode};
if ((ref($details) eq 'HASH') && (ref($domdefs) eq 'HASH')) {
my $emailenc = &escape($owneremail);
my $owner = $details->{'owner'}.':'.$details->{'domain'};
foreach my $item (@items) {
$batchhash{$item} = $details->{$item};
}
+ if (ref($details->{'crosslists'}) eq 'HASH') {
+ foreach my $key (keys(%{$details->{'crosslists'}})) {
+ if (ref($details->{'crosslists'}->{$key}) eq 'HASH') {
+ my $instsec = $details->{crosslists}->{$key}->{instsec};
+ $batchhash{'crosslists'}{$key}{'inst'} = $details->{crosslists}->{$key}->{instcode};
+ my $crskey = $cnum.':'.$batchhash{'crosslists'}{$key}{'inst'};
+ my %formatted = &Apache::lonnet::auto_instsec_reformat($dom,'clutter',
+ {$crskey => [$instsec]});
+ if (ref($formatted{$crskey}) eq 'ARRAY') {
+ $batchhash{'crosslists'}{$key}{'inst'} .= $formatted{$crskey}->[0];
+ }
+ $batchhash{'crosslists'}{$key}{'loncapa'} = $details->{crosslists}->{$key}->{loncapa};
+ }
+ }
+ }
$batchhash{'title'} = $details->{'cdescr'};
$batchhash{'coursecode'} = $details->{'instcode'};
if ($domdefs->{'officialcredits'} || $domdefs->{'unofficialcredits'}) {
@@ -1716,12 +1821,13 @@ sub build_batchcreatehash {
$batchhash{'users'}{$owner}{lastname} = $owner_lastname;
$batchhash{'users'}{$owner}{emailenc} = $emailenc;
$batchhash{'users'}{$owner}{owneremail} = $owneremail;
+ $batchhash{'setcomment'} = 1;
}
return %batchhash;
}
sub can_clone_course {
- my ($uname,$udom,$clonecrs,$clonedom,$crstype) = @_;
+ my ($uname,$udom,$clonecrs,$clonedom,$crstype,$dom,$instcode) = @_;
my $canclone;
my $ccrole = 'cc';
if ($crstype eq 'community') {
@@ -1732,19 +1838,70 @@ sub can_clone_course {
if (exists($roleshash{$clonecrs.':'.$clonedom.':'.$ccrole})) {
$canclone = 1;
} else {
- my %courseenv = &Apache::lonnet::userenvironment($clonedom,$clonecrs,('cloners'));
+ my %courseenv = &Apache::lonnet::userenvironment($clonedom,$clonecrs,
+ ('cloners','internal.coursecode'));
my $cloners = $courseenv{'cloners'};
+ my $clonefromcode = $courseenv{'internal.coursecode'};
if ($cloners ne '') {
my @cloneable = split(',',$cloners);
if (grep(/^\*$/,@cloneable)) {
$canclone = 1;
- }
- if (grep(/^\*:\Q$udom\E$/,@cloneable)) {
+ } elsif (grep(/^\*:\Q$udom\E$/,@cloneable)) {
$canclone = 1;
- }
- if (grep(/^\Q$uname\E:\Q$udom\E$/,@cloneable)) {
+ } elsif (grep(/^\Q$uname\E:\Q$udom\E$/,@cloneable)) {
$canclone = 1;
}
+ unless ($canclone) {
+ if (($clonefromcode) && ($instcode) && ($clonedom eq $dom)) {
+ my (%gotdomdefaults,%gotcodedefaults);
+ foreach my $cloner (@cloneable) {
+ if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
+ ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
+ if ($cloner =~ /\=/) {
+ my (%codedefaults,@code_order);
+ if (ref($gotcodedefaults{$clonedom}) eq 'HASH') {
+ if (ref($gotcodedefaults{$clonedom}{'defaults'}) eq 'HASH') {
+ %codedefaults = %{$gotcodedefaults{$clonedom}{'defaults'}};
+ }
+ if (ref($gotcodedefaults{$clonedom}{'order'}) eq 'ARRAY') {
+ @code_order = @{$gotcodedefaults{$dom}{'order'}};
+ }
+ } else {
+ &Apache::lonnet::auto_instcode_defaults($clonedom,
+ \%codedefaults,
+ \@code_order);
+ $gotcodedefaults{$clonedom}{'defaults'} = \%codedefaults;
+ $gotcodedefaults{$clonedom}{'order'} = \@code_order;
+ }
+ if (@code_order > 0) {
+ if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
+ $cloner,$clonefromcode,$instcode)) {
+ $canclone = 1;
+ last;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ } else {
+ my %domdefs = &Apache::lonnet::get_domain_defaults($clonedom);
+ if ($domdefs{'canclone'}) {
+ unless ($domdefs{'canclone'} eq 'none') {
+ if ($domdefs{'canclone'} eq 'domain') {
+ if ($udom eq $clonedom) {
+ $canclone = 1;
+ }
+ } elsif (($clonefromcode) && ($instcode) &&
+ ($clonedom eq $dom)) {
+ if (&Apache::lonnet::default_instcode_cloning($clonedom,$domdefs{'canclone'},
+ $clonefromcode,$instcode)) {
+ $canclone = 1;
+ }
+ }
+ }
+ }
}
unless ($canclone) {
if (&Apache::lonnet::is_course_owner($clonedom,$clonecrs,$uname,$udom)) {
@@ -2026,6 +2183,9 @@ sub process_official_reqs {
}
}
}
+ if ($history{'details'}{'clonecrs'}) {
+ $customitems{'_LC_clonefrom'} = $history{'details'}{'clonedom'}.'_'.$history{'details'}{'clonecrs'};
+ }
my ($result,$postprocess) =
&course_creation($dom,$cnum,'domain',$history{'details'},\$logmsg,\$newusermsg,\$addresult,
\$enrollcount,\$response,\$keysmsg,\%domdefs,\%longroles,\$code,\%customitems);
@@ -2156,7 +2316,7 @@ sub postprocess_crsenv {
my %needcrsidput = (
'internal.selfenroll_types' => 1,
'internal.selfenroll_start_date' => 1,
- 'internal. selfenroll_end_date' => 1,
+ 'internal.selfenroll_end_date' => 1,
);
my (@needupdate,%newcrsenv);
foreach my $key (keys(%{$postprocessenv})) {