--- loncom/interface/lonuserutils.pm 2010/09/20 00:21:08 1.125 +++ loncom/interface/lonuserutils.pm 2022/11/23 02:55:37 1.212 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Utility functions for managing LON-CAPA user accounts # -# $Id: lonuserutils.pm,v 1.125 2010/09/20 00:21:08 raeburn Exp $ +# $Id: lonuserutils.pm,v 1.212 2022/11/23 02:55:37 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); ############################################################### @@ -136,6 +154,357 @@ 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) = @_; + 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')); + 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') { + $reject->{$key} = { + cdom => $cdom, + cnum => $cnum, + csec => $csec, + udom => $udom, + uname => $uname, + role => $role, + }; + $skip = 1; + } elsif (($rule eq 'user') || ($rule eq 'domain')) { + $pending->{$key} = { + 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}->{'credits'} = $credits; + } + $skip = 1; + } + } + } elsif (exists($approval{'extdom'})) { + my $rule = $approval{'extdom'}; + if ($rule eq 'none') { + $reject->{$key} = { + cdom => $cdom, + cnum => $cnum, + csec => $csec, + udom => $udom, + uname => $uname, + role => $role, + }; + $skip = 1; + } elsif (($rule eq 'user') || ($rule eq 'domain')) { + $pending->{$key} = { + 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}->{'credits'} = $credits; + } + $skip = 1; + } + } + } + } + return $skip; +} + +sub print_roles_rejected { + my ($context,$reject) = @_; + return unless (ref($reject) 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 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('Total number of records found in file: [_1]' - ,''.$distotal.'') - ."
\n"); - $r->print(''. + &mt('Total number of records found in file: [_1]' + ,''.$distotal.''). + "
\n" + ); + if ($distotal == 0) { + $r->print(''.&mt('None found').'
'); + } + $r->print( + ''.
+ &mt('Enter as many fields as you can.').'
'.
+ &mt('The system will inform you and bring you back to this page,[_1]if the data selected are insufficient to add users.','
').
+ "
'
.''.&mt('Domain Level').'
'
@@ -898,8 +1375,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;
@@ -922,7 +1404,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();
@@ -945,35 +1429,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'}){ @@ -999,7 +1526,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); @@ -1007,6 +1536,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) = @@ -1032,6 +1562,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, @@ -1048,9 +1582,9 @@ sub print_upload_manager_form { $keyfields=join(',',sort(keys(%sone))); } } - $r->print(''. + ' | ||
'.
$lt{'exs'}.' | '.
''. ' | '.$lt{'new'}.' '. @@ -1265,7 +1806,7 @@ sub default_role_selector { ''. ''. ''. - ' |
' - .&list_submit_button(&mt('Update Display')) - ."
\n" - ); + $r->print(''.&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"); @@ -1527,10 +2072,10 @@ sub print_userlist { $clearcoursepick = 1; } if (($env{'form.coursepick'}) && (!$clearcoursepick)) { - $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('