--- loncom/interface/lonuserutils.pm 2013/01/23 17:48:37 1.147 +++ loncom/interface/lonuserutils.pm 2023/11/04 00:06:00 1.219 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Utility functions for managing LON-CAPA user accounts # -# $Id: lonuserutils.pm,v 1.147 2013/01/23 17:48:37 bisitz Exp $ +# $Id: lonuserutils.pm,v 1.219 2023/11/04 00:06:00 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -30,12 +30,30 @@ package Apache::lonuserutils; +=pod + +=head1 NAME + +Apache::lonuserutils.pm + +=head1 SYNOPSIS + + Utilities for management of users and custom roles + + Provides subroutines called by loncreateuser.pm + +=head1 OVERVIEW + +=cut + use strict; use Apache::lonnet; use Apache::loncommon(); use Apache::lonhtmlcommon; +use Apache::loncoursequeueadmin; use Apache::lonlocal; use Apache::longroup; +use HTML::Entities; use LONCAPA qw(:DEFAULT :match); ############################################################### @@ -97,7 +115,11 @@ sub modifyuserrole { } elsif ($context eq 'domain') { $scope = '/'.$env{'request.role.domain'}.'/'; } elsif ($context eq 'author') { - $scope = '/'.$env{'user.domain'}.'/'.$env{'user.name'}; + if ($env{'request.role'} =~ m{^ca\.(/$match_domain/$match_username)$}) { + $scope = $1; + } else { + $scope = '/'.$env{'user.domain'}.'/'.$env{'user.name'}; + } } if ($context eq 'domain') { my $uhome = &Apache::lonnet::homeserver($uname,$udom); @@ -136,6 +158,560 @@ sub modifyuserrole { return ($userresult,$authresult,$roleresult,$idresult); } +sub role_approval { + my ($dom,$context,$process_by,$notifydc) = @_; + if (ref($process_by) eq 'HASH') { + my %domconfig = &Apache::lonnet::get_dom('configuration',['privacy'],$dom); + if (ref($domconfig{'privacy'}) eq 'HASH') { + if (ref($notifydc) eq 'ARRAY') { + if ($domconfig{'privacy'}{'notify'} ne '') { + @{$notifydc} = split(/,/,$domconfig{'privacy'}{'notify'}); + } + } + if (ref($domconfig{'privacy'}{'approval'}) eq 'HASH') { + my %approvalconf = %{$domconfig{'privacy'}{'approval'}}; + foreach my $key ('instdom','extdom') { + if (ref($approvalconf{$key}) eq 'HASH') { + if (keys(%{$approvalconf{$key}})) { + $process_by->{$key} = $approvalconf{$key}{$context}; + } + } + } + } + } + } + return; +} + +sub get_instdoms { + my ($udom,$instdoms) = @_; + return unless (ref($instdoms) eq 'ARRAY'); + my @intdoms; + my %iphost = &Apache::lonnet::get_iphost(); + my $primary_id = &Apache::lonnet::domain($udom,'primary'); + my $primary_ip = &Apache::lonnet::get_host_ip($primary_id); + if (ref($iphost{$primary_ip}) eq 'ARRAY') { + foreach my $id (@{$iphost{$primary_ip}}) { + my $intdom = &Apache::lonnet::internet_dom($id); + unless(grep(/^\Q$intdom\E$/,@intdoms)) { + push(@intdoms,$intdom); + } + } + } + foreach my $ip (keys(%iphost)) { + if (ref($iphost{$ip}) eq 'ARRAY') { + foreach my $id (@{$iphost{$ip}}) { + my $location = &Apache::lonnet::internet_dom($id); + if ($location) { + if (grep(/^\Q$location\E$/,@intdoms)) { + my $dom = &Apache::lonnet::host_domain($id); + unless (grep(/^\Q$dom\E/,@{$instdoms})) { + push(@{$instdoms},$dom); + } + } + } + } + } + } + return; +} + +sub restricted_dom { + my ($context,$key,$udom,$uname,$role,$start,$end,$cdom,$cnum,$csec,$credits, + $process_by,$instdoms,$got_role_approvals,$got_instdoms,$reject,$pending, + $notifydc,$status,$unauthorized,$currqueued) = @_; + return if ($udom eq $cdom); + return unless ((ref($process_by) eq 'HASH') && (ref($instdoms) eq 'HASH') && + (ref($got_role_approvals) eq 'HASH') && (ref($got_instdoms) eq 'HASH') && + (ref($reject) eq 'HASH') && (ref($pending) eq 'HASH') && + (ref($notifydc) eq 'HASH') && (ref($status) eq 'HASH') && + (ref($unauthorized) eq 'HASH') && (ref($currqueued) eq 'HASH')); + my (%approval,@notify,$gotdata,$skip); + if (ref($got_role_approvals->{$context}) eq 'HASH') { + if ($got_role_approvals->{$context}{$udom}) { + $gotdata = 1; + if (ref($process_by->{$context}{$udom}) eq 'HASH') { + %approval = %{$process_by->{$context}{$udom}}; + } + } + } + unless ($gotdata) { + &role_approval($udom,$context,\%approval,\@notify); + $process_by->{$context} = { + $udom => \%approval, + }; + $got_role_approvals->{$context} = { + $udom => 1, + }; + $notifydc->{$udom} = \@notify; + } + if (ref($process_by->{$context}) eq 'HASH') { + if (ref($process_by->{$context}{$udom}) eq 'HASH') { + my @inst; + if ($got_instdoms->{$udom}) { + if (ref($instdoms->{$udom}) eq 'ARRAY') { + @inst = @{$instdoms->{$udom}}; + } + } else { + &get_instdoms(\@inst); + $instdoms->{$udom} = \@inst; + $got_instdoms->{$udom} = 1; + } + if (grep(/^\Q$cdom\E$/,@inst)) { + if (exists($approval{'instdom'})) { + my $rule = $approval{'instdom'}; + if (($rule eq 'none') || ($rule eq 'user') || ($rule eq 'domain')) { + my ($id,$currstatus,$curradj) = &get_othdomreq_status($key,$uname,$udom,$role,$cdom,$cnum,$csec); + if (($currstatus ne '') && ($curradj eq $rule)) { + $status->{$key}->{$uname.':'.$udom} = $currstatus; + } + if ($rule eq 'none') { + $reject->{$key}->{$uname.':'.$udom} = { + cdom => $cdom, + cnum => $cnum, + csec => $csec, + udom => $udom, + uname => $uname, + role => $role, + }; + $skip = 1; + } elsif (($rule eq 'user') || ($rule eq 'domain')) { + if ($curradj eq $rule) { + unless ($currstatus eq 'approved') { + if ($currstatus eq 'rejected') { + $unauthorized->{$key}->{$uname.':'.$udom} = { + cdom => $cdom, + cnum => $cnum, + csec => $csec, + udom => $udom, + uname => $uname, + role => $role, + }; + } elsif ($currstatus eq 'pending') { + $currqueued->{$key}->{$uname.':'.$udom} = { + cdom => $cdom, + cnum => $cnum, + csec => $csec, + udom => $udom, + uname => $uname, + role => $role, + adj => $rule, + }; + } + $skip = 1; + } + } else { + $pending->{$key}->{$uname.':'.$udom} = { + cdom => $cdom, + cnum => $cnum, + csec => $csec, + udom => $udom, + uname => $uname, + role => $role, + start => $start, + end => $end, + adj => $rule, + }; + if (($role eq 'st') && ($credits ne '')) { + $pending->{$key}->{$uname.':'.$udom}->{'credits'} = $credits; + } + $skip = 1; + } + } + } + } + } elsif (exists($approval{'extdom'})) { + my $rule = $approval{'extdom'}; + if (($rule eq 'none') || ($rule eq 'user') || ($rule eq 'domain')) { + my ($id,$currstatus,$curradj) = &get_othdomreq_status($key,$uname,$udom,$role,$cdom,$cnum,$csec); + if (($currstatus ne '') && ($curradj eq $rule)) { + $status->{$key}->{$uname.':'.$udom} = $currstatus; + } + if ($rule eq 'none') { + $reject->{$key}->{$uname.':'.$udom} = { + cdom => $cdom, + cnum => $cnum, + csec => $csec, + udom => $udom, + uname => $uname, + role => $role, + }; + $skip = 1; + } elsif (($rule eq 'user') || ($rule eq 'domain')) { + if ($curradj eq $rule) { + unless ($currstatus eq 'approved') { + if ($currstatus eq 'rejected') { + $unauthorized->{$key}->{$uname.':'.$udom} = { + cdom => $cdom, + cnum => $cnum, + csec => $csec, + udom => $udom, + uname => $uname, + role => $role, + }; + } elsif ($currstatus eq 'pending') { + $currqueued->{$key}->{$uname.':'.$udom} = { + cdom => $cdom, + cnum => $cnum, + csec => $csec, + udom => $udom, + uname => $uname, + role => $role, + adj => $rule, + }; + } + $skip = 1; + } + } else { + $pending->{$key}->{$uname.':'.$udom} = { + cdom => $cdom, + cnum => $cnum, + csec => $csec, + udom => $udom, + uname => $uname, + role => $role, + start => $start, + end => $end, + adj => $rule, + }; + if (($role eq 'st') && ($credits ne '')) { + $pending->{$key}->{$uname.':'.$udom}->{'credits'} = $credits; + } + $skip = 1; + } + } + } + } + } + } + return $skip; +} + +sub get_othdomreq_status { + my ($key,$uname,$udom,$role,$cdom,$cnum,$csec) = @_; + my $id = $uname.':'.$udom.':'.$role; + my ($dbnum,$currstatus,$curradj); + if (($role eq 'ca') || ($role eq 'aa')) { + $dbnum = $cnum; + } elsif ($key eq $cdom.'_'.$role) { + $dbnum = &Apache::lonnet::get_domainconfiguser($cdom); + } else { + $id .= ':'.$csec; + $dbnum = $cnum; + } + my $statusid = 'status&'.$id; + my %curr = &Apache::lonnet::get('nohist_othdomqueued',[$id,$statusid],$cdom,$dbnum); + if (ref($curr{$id}) eq 'HASH') { + $curradj = $curr{$id}{'adj'}; + } + $currstatus = $curr{$statusid}; + return ($id,$currstatus,$curradj); +} + +sub print_roles_rejected { + my ($context,$reject,$unauthorized) = @_; + return unless ((ref($reject) eq 'HASH') || (ref($unauthorized) eq 'HASH')); + my $output; + if (keys(%{$reject}) > 0) { + $output = '
'. + &mt("The following roles could not be assigned because the user is from another domain, and that domain's policies disallow it").'
'. + &mt("The following roles could not be assigned because the user is from another domain, and that domain's policies require approval by the user themselves or by a domain coordinator in that domain, and approval has been withheld.").'
'. + &mt("The following role assignments have been queued because the user is from another domain, and that domain's policies require approval by the user themselves or by a domain coordinator in that domain").'
'. + &mt("The following role assignments were already queued because the user is from another domain, and that domain's policies require approval by the user themselves or by a domain coordinator in that domain").'
'
.''.&mt('Domain Level').'
'
@@ -947,8 +1582,13 @@ sub print_upload_manager_footer {
} else {
my ($cnum,$cdom) = &get_course_identity();
my $rowtitle = &mt('section');
- my $secbox = §ion_picker($cdom,$cnum,'Any',$rowtitle,
- $permission,$context,'upload',$crstype);
+ my $defaultcredits;
+ if ($showcredits) {
+ $defaultcredits = &get_defaultcredits();
+ }
+ my $secbox = §ion_picker($cdom,$cnum,'Any',$rowtitle,$permission,
+ $context,'upload',$crstype,$showcredits,
+ $defaultcredits);
$Str .= $secbox
.&Apache::lonhtmlcommon::row_closure();
my %lt;
@@ -971,7 +1611,9 @@ sub print_upload_manager_footer {
.&Apache::lonhtmlcommon::row_closure();
}
if ($context eq 'course' || $context eq 'domain') {
- $Str .= &forceid_change($context);
+ $Str .= &Apache::lonhtmlcommon::row_title(&mt('Student/Employee ID'))
+ .&forceid_change($context)
+ .&Apache::lonhtmlcommon::row_closure(1); # last row in pick_box
}
$Str .= &Apache::lonhtmlcommon::end_pick_box();
@@ -994,35 +1636,78 @@ sub print_upload_manager_footer {
return;
}
+sub get_defaultcredits {
+ my ($cdom,$cnum) = @_;
+
+ if ($cdom eq '' || $cnum eq '') {
+ return unless ($env{'request.course.id'});
+ $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ }
+ return unless(($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/));
+ my ($defaultcredits,$domdefcredits);
+ my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
+ if ($domdefaults{'officialcredits'} || $domdefaults{'unofficialcredits'} || $domdefaults{'textbookcredits'}) {
+ my $instcode = $env{'course.'.$cdom.'_'.$cnum.'.internal.coursecode'};
+ if ($instcode) {
+ $domdefcredits = $domdefaults{'officialcredits'};
+ } elsif ($env{'course.'.$cdom.'_'.$cnum.'.internal.textbook'}) {
+ $domdefcredits = $domdefaults{'textbookcredits'};
+ } else {
+ $domdefcredits = $domdefaults{'unofficialcredits'};
+ }
+ } else {
+ return;
+ }
+
+ if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
+ $defaultcredits = $env{'course.'.$cdom.'_'.$cnum.'.internal.defaultcredits'};
+ } elsif (exists($env{'course.'.$cdom.'_'.$cnum.'.internal.defaultcredits'})) {
+ $defaultcredits = $env{'course.'.$cdom.'_'.$cnum.'.internal.defaultcredits'};
+ } else {
+ my %crsinfo =
+ &Apache::lonnet::coursedescription("$cdom/$cnum",{'one_time' => 1});
+ $defaultcredits = $crsinfo{'internal.defaultcredits'};
+ }
+ if ($defaultcredits eq '') {
+ $defaultcredits = $domdefcredits;
+ }
+ return $defaultcredits;
+}
+
sub forceid_change {
my ($context) = @_;
my $output =
- &Apache::lonhtmlcommon::row_title(&mt('Student/Employee ID'))
- .'
'."\n"
- .&mt('(only do if you know what you are doing.)')."\n";
+ ''.&Apache::loncommon::help_open_topic('ForceIDChange')."\n";
if ($context eq 'domain') {
- $output .= '
'."\n";
+ $output .=
+ '
'
+ .''."\n";
}
- $output .= &Apache::lonhtmlcommon::row_closure(1); # last row in pick_box
return $output;
}
###############################################################
###############################################################
sub print_upload_manager_form {
- my ($r,$context,$permission,$crstype) = @_;
+ my ($r,$context,$permission,$crstype,$showcredits) = @_;
my $firstLine;
my $datatoken;
if (!$env{'form.datatoken'}) {
$datatoken=&Apache::loncommon::upfile_store($r);
} else {
- $datatoken=$env{'form.datatoken'};
- &Apache::loncommon::load_tmp_file($r);
+ $datatoken=&Apache::loncommon::valid_datatoken($env{'form.datatoken'});
+ if ($datatoken ne '') {
+ &Apache::loncommon::load_tmp_file($r,$datatoken);
+ }
+ }
+ if ($datatoken eq '') {
+ $r->print('
'.&mt('Error').': '. + &mt('Invalid datatoken').'
'); + return 'missingdata'; } my @records=&Apache::loncommon::upfile_record_sep(); if($env{'form.noFirstLine'}){ @@ -1048,7 +1733,9 @@ sub print_upload_manager_form { 'domain_choice' => 'scalar', 'inststatus_choice' => 'scalar', }; - my $defdom = $env{'request.role.domain'}; + if ($showcredits) { + $col_setting_names->{'credits_choice'} = 'scalar'; + } if ($context eq 'course') { &Apache::loncommon::restore_course_settings('enrollment_upload', $col_setting_names); @@ -1056,6 +1743,7 @@ sub print_upload_manager_form { &Apache::loncommon::restore_settings($context,'user_upload', $col_setting_names); } + my $defdom = $env{'request.role.domain'}; # # Determine kerberos parameters as appropriate my ($krbdef,$krbdefdom) = @@ -1081,6 +1769,10 @@ sub print_upload_manager_form { ['role',&mt('Role'), $env{'form.role_choice'}], ['domain',&mt('Domain'), $env{'form.domain_choice'}], ['inststatus',&mt('Affiliation'), $env{'form.inststatus_choice'}]); + if ($showcredits) { + push(@field, + ['credits',&mt('Student Credits'), $env{'form.credits_choice'}]); + } if ($env{'form.upfile_associate'} eq 'reverse') { &Apache::loncommon::csv_print_samples($r,\@records); $i=&Apache::loncommon::csv_print_select_table($r,\@records, @@ -1098,7 +1790,8 @@ sub print_upload_manager_form { } } &print_upload_manager_footer($r,$i,$keyfields,$defdom,$today,$halfyear, - $context,$permission,$crstype); + $context,$permission,$crstype,$showcredits); + return 'ok'; } sub setup_date_selectors { @@ -1255,7 +1948,7 @@ sub make_dates_default { } sub default_role_selector { - my ($context,$checkpriv,$crstype) = @_; + my ($context,$checkpriv,$crstype,$showcredits) = @_; my %customroles; my ($options,$coursepick,$cb_jscript); if ($context ne 'author') { @@ -1267,6 +1960,7 @@ sub default_role_selector { 'grs' => "Section", 'exs' => "Existing sections", 'new' => "New section", + 'crd' => "Credits", ); $options = ''. + ' | ||
'.
$lt{'exs'}.' | '.
''. ' | '.$lt{'new'}.' '. @@ -1313,7 +2013,7 @@ sub default_role_selector { ''. ''. ''. - ' |
'.&Apache::lonhtmlcommon::start_pick_box()."\n". - &Apache::lonhtmlcommon::start_pick_box()."\n". - &Apache::lonhtmlcommon::row_title($title,'LC_oddrow_value')."\n". + $r->print('
'. &list_submit_button(&mt('Update Display')). "\n".'
'.$warning.''."\n"); @@ -1585,7 +2290,7 @@ sub print_userlist { $r->print(''."\n") if $msg; + $r->print('
'.$msg.'
'."\n") if $msg; } else { # Print out the available choices my $usercount; if ($env{'form.action'} eq 'modifystudent') { ($usercount) = &show_users_list($r,$context,'view',$permission, - $env{'form.Status'},\%userlist,$keylist); + $env{'form.Status'},\%userlist,$keylist,'', + $showcredits); } else { ($usercount) = &show_users_list($r,$context,$env{'form.output'}, - $permission,$env{'form.Status'},\%userlist,$keylist); + $permission,$env{'form.Status'},\%userlist, + $keylist,'',$showcredits,$needauthorquota,$needauthorusage); } if (!$usercount) { $r->print(''.&mt('manual').' | |||||||||||||||||||||||||||
';
+ $cellentry = '
| '); + 'actionlist" value="'. + &HTML::Entities::encode($checkval,'&<>"').'" />'); + foreach my $item ('start','end') { + $r->print(''); + } + $r->print(''); } else { $r->print(' | '); } @@ -2910,8 +3763,6 @@ END foreach my $item (@cols) { if ($item eq 'username') { $r->print(' | '.&print_username_link($mode,\%in).' | '); - } elsif (($item eq 'start' || $item eq 'end') && ($actionselect)) { - $r->print(''.$in{$item}.' | '."\n"); } elsif ($item eq 'status') { my $showitem = $in{$item}; if (defined($ltstatus{$in{$item}})) { @@ -2937,7 +3788,9 @@ END } else { $r->print(''."\n"); } - } + } + } elsif (($item eq 'authorquota') || ($item eq 'authorusage')) { + $r->print(' | '.$in{$item}.' | '."\n"); } else { $r->print(''.$in{$item}.' | '."\n"); } @@ -2973,10 +3826,10 @@ END $r->print(&Apache::loncommon::end_data_table().'$lt{'usrn'} | $lt{'dom'} | -ID | +$lt{'id'} | $nametitle | $lt{'sec'} | $lt{'start'} | @@ -3729,21 +4602,21 @@ END $r->print(<- $lt{'usrn'} + $lt{'usrn'} | - $lt{'dom'} + $lt{'dom'} | - ID + $lt{'id'} | - $nametitle + $nametitle | - $lt{'sec'} + $lt{'sec'} | - $lt{'start'} + $lt{'start'} | - $lt{'end'} + $lt{'end'} | - $lt{'groups'} + $lt{'groups'} | END $r->print(&Apache::loncommon::end_data_table_header_row()); @@ -3814,7 +4687,6 @@ END $btn = $lt{'dm'}; } $r->print(<<"END"); -'.$authformlti.' | '. + &Apache::loncommon::end_data_table_row()."\n"; + } $response .= &Apache::loncommon::end_data_table(); } return $response; } sub course_sections { - my ($sections_count,$role,$current_sec) = @_; + my ($sections_count,$role,$current_sec,$disabled) = @_; my $output = ''; - my @sections = (sort {$a <=> $b} keys %{$sections_count}); + my @sections = (sort {$a <=> $b} keys(%{$sections_count})); my $numsec = scalar(@sections); my $is_selected = ' selected="selected"'; if ($numsec <= 1) { - $output = '
---|