# The LearningOnline Network with CAPA
# Create a user
#
# $Id: loncreateuser.pm,v 1.406.2.11 2017/01/24 05:35:35 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
###
package Apache::loncreateuser;
=pod
=head1 NAME
Apache::loncreateuser.pm
=head1 SYNOPSIS
Handler to create users and custom roles
Provides an Apache handler for creating users,
editing their login parameters, roles, and removing roles, and
also creating and assigning custom roles.
=head1 OVERVIEW
=head2 Custom Roles
In LON-CAPA, roles are actually collections of privileges. "Teaching
Assistant", "Course Coordinator", and other such roles are really just
collection of privileges that are useful in many circumstances.
Custom roles can be defined by a Domain Coordinator, Course Coordinator
or Community Coordinator via the Manage User functionality.
The custom role editor screen will show all privileges which can be
assigned to users. For a complete list of privileges, please see
C.
Custom role definitions are stored in the C '.$userpicker.' '
.&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
.' ';
if ($context eq 'domain') {
$response .= &mt('Please contact a [_1] for assistance.',
&Apache::lonnet::plaintext('dc'));
} else {
$response .= &mt('Please contact the [_1]helpdesk[_2] for assistance.'
,'','');
}
$response .= ' '
.&mt('Unable to determine home server for [_1] in domain [_2].',
'"'.$env{'form.ccuname'}.'"','"'.$env{'form.ccdomain'}.'"')
.' '
.&mt('Unable to successfully change environment for [_1] in domain [_2].',
'"'.$env{'form.ccuname'}.'"',
'"'.$env{'form.ccdomain'}.'"')
.' '.&mt('No changes made to user information').' '.&mt('ERROR').': '.&mt('Unknown command').' '.$key.' ');
if (($key eq 'none') || ($key eq 'all')) {
$r->print(&mt('[_1] may not be used as the name for a section, as it is a reserved word.',''.$key.''));
} else {
$r->print(&mt('[_1] may not be used as the name for a section, as it is the name of a course group.',''.$key.''));
}
$r->print(' '
.&mt('Please [_1]go back[_2] and choose a different section name.'
,'');
if ($crstype eq 'Community') {
$r->print(&mt('If the member is currently logged-in to LON-CAPA, the new role can be displayed by using the "Check for changes" link on the Roles/Courses page.'));
} else {
$r->print(&mt('If the student is currently logged-in to LON-CAPA, the new role can be displayed by using the "Check for changes" link on the Roles/Courses page.'));
}
$r->print(''.$lt{'usrt'}.'
'."\n".
&Apache::loncommon::start_data_table();
if ((&Apache::lonnet::allowed('mut',$ccdomain)) ||
(&Apache::lonnet::allowed('udp',$ccdomain))) {
$output .= &build_tools_display($ccuname,$ccdomain,'tools');
}
my %titles = &Apache::lonlocal::texthash (
portfolio => "Disk space allocated to user's portfolio files",
author => "Disk space allocated to user's Authoring Space (if role assigned)",
);
foreach my $name ('portfolio','author') {
my ($currquota,$quotatype,$inststatus,$defquota) =
&Apache::loncommon::get_user_quota($ccuname,$ccdomain,$name);
if ($longinsttype eq '') {
if ($inststatus ne '') {
if ($usertypes->{$inststatus} ne '') {
$longinsttype = $usertypes->{$inststatus};
}
}
}
my ($showquota,$custom_on,$custom_off,$defaultinfo);
$custom_on = ' ';
$custom_off = ' checked="checked" ';
if ($quotatype eq 'custom') {
$custom_on = $custom_off;
$custom_off = ' ';
$showquota = $currquota;
if ($longinsttype eq '') {
$defaultinfo = &mt('For this user, the default quota would be [_1]'
.' MB.',$defquota);
} else {
$defaultinfo = &mt("For this user, the default quota would be [_1]".
" MB, as determined by the user's institutional".
" affiliation ([_2]).",$defquota,$longinsttype);
}
} else {
if ($longinsttype eq '') {
$defaultinfo = &mt('For this user, the default quota is [_1]'
.' MB.',$defquota);
} else {
$defaultinfo = &mt("For this user, the default quota of [_1]".
" MB, is determined by the user's institutional".
" affiliation ([_2]).",$defquota,$longinsttype);
}
}
if (&Apache::lonnet::allowed('mpq',$ccdomain)) {
$output .= ''."\n".
' '."\n".
&Apache::loncommon::start_data_table_row()."\n".
' '.$titles{$name}.' '."\n".
' '.
&mt('Current quota: [_1] MB',$currquota).' '.
$defaultinfo.' '."\n".
&Apache::loncommon::end_data_table_row()."\n".
&Apache::loncommon::start_data_table_row()."\n".
' '.$lt{'chqu'}.
': '.
' '.
' '.&mt('MB').' '."\n".
&Apache::loncommon::end_data_table_row()."\n";
}
}
$output .= &Apache::loncommon::end_data_table();
return $output;
}
sub build_tools_display {
my ($ccuname,$ccdomain,$context) = @_;
my (@usertools,%userenv,$output,@options,%validations,%reqtitles,%reqdisplay,
$colspan,$isadv,%domconfig);
my %lt = &Apache::lonlocal::texthash (
'blog' => "Personal User Blog",
'aboutme' => "Personal Information Page",
'webdav' => "WebDAV access to Authoring Spaces (if SSL and author/co-author)",
'portfolio' => "Personal User Portfolio",
'avai' => "Available",
'cusa' => "availability",
'chse' => "Change setting",
'usde' => "Use default",
'uscu' => "Use custom",
'official' => 'Can request creation of official courses',
'unofficial' => 'Can request creation of unofficial courses',
'community' => 'Can request creation of communities',
'textbook' => 'Can request creation of textbook courses',
'requestauthor' => 'Can request author space',
);
if ($context eq 'requestcourses') {
%userenv = &Apache::lonnet::userenvironment($ccdomain,$ccuname,
'requestcourses.official','requestcourses.unofficial',
'requestcourses.community','requestcourses.textbook');
@usertools = ('official','unofficial','community','textbook');
@options =('norequest','approval','autolimit','validate');
%validations = &Apache::lonnet::auto_courserequest_checks($ccdomain);
%reqtitles = &courserequest_titles();
%reqdisplay = &courserequest_display();
$colspan = ' colspan="2"';
%domconfig =
&Apache::lonnet::get_dom('configuration',['requestcourses'],$ccdomain);
$isadv = &Apache::lonnet::is_advanced_user($ccdomain,$ccuname);
} elsif ($context eq 'requestauthor') {
%userenv = &Apache::lonnet::userenvironment($ccdomain,$ccuname,
'requestauthor');
@usertools = ('requestauthor');
@options =('norequest','approval','automatic');
%reqtitles = &requestauthor_titles();
%reqdisplay = &requestauthor_display();
$colspan = ' colspan="2"';
%domconfig =
&Apache::lonnet::get_dom('configuration',['requestauthor'],$ccdomain);
} else {
%userenv = &Apache::lonnet::userenvironment($ccdomain,$ccuname,
'tools.aboutme','tools.portfolio','tools.blog',
'tools.webdav');
@usertools = ('aboutme','blog','webdav','portfolio');
}
foreach my $item (@usertools) {
my ($custom_access,$curr_access,$cust_on,$cust_off,$tool_on,$tool_off,
$currdisp,$custdisp,$custradio);
$cust_off = 'checked="checked" ';
$tool_on = 'checked="checked" ';
$curr_access =
&Apache::lonnet::usertools_access($ccuname,$ccdomain,$item,undef,
$context);
if ($context eq 'requestauthor') {
if ($userenv{$context} ne '') {
$cust_on = ' checked="checked" ';
$cust_off = '';
}
} elsif ($userenv{$context.'.'.$item} ne '') {
$cust_on = ' checked="checked" ';
$cust_off = '';
}
if ($context eq 'requestcourses') {
if ($userenv{$context.'.'.$item} eq '') {
$custom_access = &mt('Currently from default setting.');
} else {
$custom_access = &mt('Currently from custom setting.');
}
} elsif ($context eq 'requestauthor') {
if ($userenv{$context} eq '') {
$custom_access = &mt('Currently from default setting.');
} else {
$custom_access = &mt('Currently from custom setting.');
}
} else {
if ($userenv{$context.'.'.$item} eq '') {
$custom_access =
&mt('Availability determined currently from default setting.');
if (!$curr_access) {
$tool_off = 'checked="checked" ';
$tool_on = '';
}
} else {
$custom_access =
&mt('Availability determined currently from custom setting.');
if ($userenv{$context.'.'.$item} == 0) {
$tool_off = 'checked="checked" ';
$tool_on = '';
}
}
}
$output .= ' '."\n".
' '."\n".
&Apache::loncommon::start_data_table_row()."\n";
if (($context eq 'requestcourses') || ($context eq 'requestauthor')) {
my ($curroption,$currlimit);
my $envkey = $context.'.'.$item;
if ($context eq 'requestauthor') {
$envkey = $context;
}
if ($userenv{$envkey} ne '') {
$curroption = $userenv{$envkey};
} else {
my (@inststatuses);
if ($context eq 'requestcourses') {
$curroption =
&Apache::loncoursequeueadmin::get_processtype('course',$ccuname,$ccdomain,
$isadv,$ccdomain,$item,
\@inststatuses,\%domconfig);
} else {
$curroption =
&Apache::loncoursequeueadmin::get_processtype('requestauthor',$ccuname,$ccdomain,
$isadv,$ccdomain,undef,
\@inststatuses,\%domconfig);
}
}
if (!$curroption) {
$curroption = 'norequest';
}
if ($curroption =~ /^autolimit=(\d*)$/) {
$currlimit = $1;
if ($currlimit eq '') {
$currdisp = &mt('Yes, automatic creation');
} else {
$currdisp = &mt('Yes, up to [quant,_1,request]/user',$currlimit);
}
} else {
$currdisp = $reqdisplay{$curroption};
}
$custdisp = ''.$lt{$item}.' '."\n".
' ';
foreach my $option (@options) {
my $val = $option;
if ($option eq 'norequest') {
$val = 0;
}
if ($option eq 'validate') {
my $canvalidate = 0;
if (ref($validations{$item}) eq 'HASH') {
if ($validations{$item}{'_custom_'}) {
$canvalidate = 1;
}
}
next if (!$canvalidate);
}
my $checked = '';
if ($option eq $curroption) {
$checked = ' checked="checked"';
} elsif ($option eq 'autolimit') {
if ($curroption =~ /^autolimit/) {
$checked = ' checked="checked"';
}
}
my $name = 'crsreq_'.$item;
if ($context eq 'requestauthor') {
$name = $item;
}
$custdisp .= '
';
$custradio = ' ';
}
$custdisp .= ' ';
if ($option eq 'autolimit') {
$custdisp .= '
'.
$reqtitles{'unlimited'};
} else {
$custdisp .= '';
}
$custdisp .= ''.&mt('Custom setting').'
'.$custdisp;
} else {
$currdisp = ($curr_access?&mt('Yes'):&mt('No'));
my $name = $context.'_'.$item;
if ($context eq 'requestauthor') {
$name = $context;
}
$custdisp = ' ';
$custradio = (' 'x2).'--'.$lt{'cusa'}.': '.$custdisp.
'';
}
$output .= ' '.$custom_access.(' 'x4).
$lt{'avai'}.': '.$currdisp.' '."\n".
&Apache::loncommon::end_data_table_row()."\n";
unless (&Apache::lonnet::allowed('udp',$ccdomain)) {
$output .=
&Apache::loncommon::start_data_table_row()."\n".
' '.
$lt{'chse'}.': '.(' ' x3).
''.$custradio.' '.
&Apache::loncommon::end_data_table_row()."\n";
}
}
return $output;
}
sub coursereq_externaluser {
my ($ccuname,$ccdomain,$cdom) = @_;
my (@usertools,@options,%validations,%userenv,$output);
my %lt = &Apache::lonlocal::texthash (
'official' => 'Can request creation of official courses',
'unofficial' => 'Can request creation of unofficial courses',
'community' => 'Can request creation of communities',
'textbook' => 'Can request creation of textbook courses',
);
%userenv = &Apache::lonnet::userenvironment($ccdomain,$ccuname,
'reqcrsotherdom.official','reqcrsotherdom.unofficial',
'reqcrsotherdom.community','reqcrsotherdom.textbook');
@usertools = ('official','unofficial','community','textbook');
@options = ('approval','validate','autolimit');
%validations = &Apache::lonnet::auto_courserequest_checks($cdom);
my $optregex = join('|',@options);
my %reqtitles = &courserequest_titles();
foreach my $item (@usertools) {
my ($curroption,$currlimit,$tooloff);
if ($userenv{'reqcrsotherdom.'.$item} ne '') {
my @curr = split(',',$userenv{'reqcrsotherdom.'.$item});
foreach my $req (@curr) {
if ($req =~ /^\Q$cdom\E\:($optregex)=?(\d*)$/) {
$curroption = $1;
$currlimit = $2;
last;
}
}
if (!$curroption) {
$curroption = 'norequest';
$tooloff = ' checked="checked"';
}
} else {
$curroption = 'norequest';
$tooloff = ' checked="checked"';
}
$output.= &Apache::loncommon::start_data_table_row()."\n".
' '.$lt{$item}.': '.
' '."\n".
&Apache::loncommon::end_data_table_row()."\n";
}
return $output;
}
sub domainrole_req {
my ($ccuname,$ccdomain) = @_;
return ''."\n".
' ';
foreach my $option (@options) {
if ($option eq 'validate') {
my $canvalidate = 0;
if (ref($validations{$item}) eq 'HASH') {
if ($validations{$item}{'_external_'}) {
$canvalidate = 1;
}
}
next if (!$canvalidate);
}
my $checked = '';
if ($option eq $curroption) {
$checked = ' checked="checked"';
}
$output .= '';
if ($option eq 'autolimit') {
$output .= ' '.
' ';
}
$output .= '
'.$reqtitles{'unlimited'};
} else {
$output .= '';
}
$output .= ''.
&mt('User Can Request Assignment of Domain Roles?').
'
'."\n".
&Apache::loncommon::start_data_table().
&build_tools_display($ccuname,$ccdomain,
'requestauthor').
&Apache::loncommon::end_data_table();
}
sub courserequest_titles {
my %titles = &Apache::lonlocal::texthash (
official => 'Official',
unofficial => 'Unofficial',
community => 'Communities',
textbook => 'Textbook',
norequest => 'Not allowed',
approval => 'Approval by Dom. Coord.',
validate => 'With validation',
autolimit => 'Numerical limit',
unlimited => '(blank for unlimited)',
);
return %titles;
}
sub courserequest_display {
my %titles = &Apache::lonlocal::texthash (
approval => 'Yes, need approval',
validate => 'Yes, with validation',
norequest => 'No',
);
return %titles;
}
sub requestauthor_titles {
my %titles = &Apache::lonlocal::texthash (
norequest => 'Not allowed',
approval => 'Approval by Dom. Coord.',
automatic => 'Automatic approval',
);
return %titles;
}
sub requestauthor_display {
my %titles = &Apache::lonlocal::texthash (
approval => 'Yes, need approval',
automatic => 'Yes, automatic approval',
norequest => 'No',
);
return %titles;
}
sub requestchange_display {
my %titles = &Apache::lonlocal::texthash (
approval => "availability set to 'on' (approval required)",
automatic => "availability set to 'on' (automatic approval)",
norequest => "availability set to 'off'",
);
return %titles;
}
sub curr_requestauthor {
my ($uname,$udom,$isadv,$inststatuses,$domconfig) = @_;
return unless ((ref($inststatuses) eq 'ARRAY') && (ref($domconfig) eq 'HASH'));
if ($uname eq '' || $udom eq '') {
$uname = $env{'user.name'};
$udom = $env{'user.domain'};
$isadv = $env{'user.adv'};
}
my (%userenv,%settings,$val);
my @options = ('automatic','approval');
%userenv =
&Apache::lonnet::userenvironment($udom,$uname,'requestauthor','inststatus');
if ($userenv{'requestauthor'}) {
$val = $userenv{'requestauthor'};
@{$inststatuses} = ('_custom_');
} else {
my %alltasks;
if (ref($domconfig->{'requestauthor'}) eq 'HASH') {
%settings = %{$domconfig->{'requestauthor'}};
if (($isadv) && ($settings{'_LC_adv'} ne '')) {
$val = $settings{'_LC_adv'};
@{$inststatuses} = ('_LC_adv_');
} else {
if ($userenv{'inststatus'} ne '') {
@{$inststatuses} = split(',',$userenv{'inststatus'});
} else {
@{$inststatuses} = ('default');
}
foreach my $status (@{$inststatuses}) {
if (exists($settings{$status})) {
my $value = $settings{$status};
next unless ($value);
unless (exists($alltasks{$value})) {
if (ref($alltasks{$value}) eq 'ARRAY') {
unless(grep(/^\Q$status\E$/,@{$alltasks{$value}})) {
push(@{$alltasks{$value}},$status);
}
} else {
@{$alltasks{$value}} = ($status);
}
}
}
}
foreach my $option (@options) {
if ($alltasks{$option}) {
$val = $option;
last;
}
}
}
}
}
return $val;
}
# =================================================================== Phase one
sub print_username_entry_form {
my ($r,$context,$response,$srch,$forcenewuser,$crstype,$brcrum) = @_;
my $defdom=$env{'request.role.domain'};
my $formtoset = 'crtuser';
if (exists($env{'form.startrolename'})) {
$formtoset = 'docustom';
$env{'form.rolename'} = $env{'form.startrolename'};
} elsif ($env{'form.origform'} eq 'crtusername') {
$formtoset = $env{'form.origform'};
}
my ($jsback,$elements) = &crumb_utilities();
my $jscript = &Apache::loncommon::studentbrowser_javascript()."\n".
''."\n";
my %existingroles=&Apache::lonuserutils::my_custom_roles($crstype);
if (($env{'form.action'} eq 'custom') && (keys(%existingroles) > 0)
&& (&Apache::lonnet::allowed('mcr','/'))) {
$jscript .= &customrole_javascript();
}
my $helpitem = 'Course_Change_Privileges';
if ($env{'form.action'} eq 'custom') {
$helpitem = 'Course_Editing_Custom_Roles';
} elsif ($env{'form.action'} eq 'singlestudent') {
$helpitem = 'Course_Add_Student';
} elsif ($env{'form.action'} eq 'accesslogs') {
$helpitem = 'Domain_User_Access_Logs';
}
my %breadcrumb_text = &singleuser_breadcrumb($crstype,$context,$defdom);
if ($env{'form.action'} eq 'custom') {
push(@{$brcrum},
{href=>"javascript:backPage(document.crtuser)",
text=>"Pick custom role",
help => $helpitem,}
);
} else {
push (@{$brcrum},
{href => "javascript:backPage(document.crtuser)",
text => $breadcrumb_text{'search'},
help => $helpitem,
faq => 282,
bug => 'Instructor Interface',}
);
}
my %loaditems = (
'onload' => "javascript:setFormElements(document.$formtoset)",
);
my $args = {bread_crumbs => $brcrum,
bread_crumbs_component => 'User Management',
add_entries => \%loaditems,};
$r->print(&Apache::loncommon::start_page('User Management',$jscript,$args));
my %lt=&Apache::lonlocal::texthash(
'srst' => 'Search for a user and enroll as a student',
'srme' => 'Search for a user and enroll as a member',
'srad' => 'Search for a user and modify/add user information or roles',
'srvu' => 'Search for a user and view user information and roles',
'srva' => 'Search for a user and view access log information',
'usr' => "Username",
'dom' => "Domain",
'ecrp' => "Define or Edit Custom Role",
'nr' => "role name",
'cre' => "Next",
);
if ($env{'form.action'} eq 'custom') {
if (&Apache::lonnet::allowed('mcr','/')) {
my $newroletext = &mt('Define new custom role:');
$r->print('');
}
} else {
my $actiontext = $lt{'srad'};
if ($env{'form.action'} eq 'singlestudent') {
if ($crstype eq 'Community') {
$actiontext = $lt{'srme'};
} else {
$actiontext = $lt{'srst'};
}
} elsif ($env{'form.action'} eq 'accesslogs') {
$actiontext = $lt{'srva'};
} elsif (($env{'form.action'} eq 'singleuser') &&
($context eq 'domain') && (!&Apache::lonnet::allowed('mau',$defdom))) {
$actiontext = $lt{'srvu'};
}
$r->print("$actiontext
");
if ($env{'form.origform'} ne 'crtusername') {
if ($response) {
$r->print("\n
');
}
}
$r->print(&entry_form($defdom,$srch,$forcenewuser,$context,$response,$crstype,1));
}
}
sub customrole_javascript {
my $js = <<"END";
END
return $js;
}
sub entry_form {
my ($dom,$srch,$forcenewuser,$context,$responsemsg,$crstype,$fixeddom) = @_;
my ($usertype,$inexact);
if (ref($srch) eq 'HASH') {
if (($srch->{'srchin'} eq 'dom') &&
($srch->{'srchby'} eq 'uname') &&
($srch->{'srchtype'} eq 'exact') &&
($srch->{'srchdomain'} ne '') &&
($srch->{'srchterm'} ne '')) {
my (%curr_rules,%got_rules);
my ($rules,$ruleorder) =
&Apache::lonnet::inst_userrules($srch->{'srchdomain'},'username');
$usertype = &Apache::lonuserutils::check_usertype($srch->{'srchdomain'},$srch->{'srchterm'},$rules,\%curr_rules,\%got_rules);
} else {
$inexact = 1;
}
}
my $cancreate =
&Apache::lonuserutils::can_create_user($dom,$context,$usertype);
my ($userpicker,$cansearch) =
&Apache::loncommon::user_picker($dom,$srch,$forcenewuser,
'document.crtuser',$cancreate,$usertype,$context,$fixeddom);
my $srchbutton = &mt('Search');
if ($env{'form.action'} eq 'singlestudent') {
$srchbutton = &mt('Search and Enroll');
} elsif ($env{'form.action'} eq 'accesslogs') {
$srchbutton = &mt('Search');
} elsif ($cancreate && $responsemsg ne '' && $inexact) {
$srchbutton = &mt('Search or Add New User');
}
my $output;
if ($cansearch) {
$output = <<"ENDBLOCK";
ENDBLOCK
} else {
$output = '
ENDDOCUMENT
}
return $output;
}
sub user_modification_js {
my ($pjump_def,$dc_setcourse_code,$nondc_setsection_code,$groupslist)=@_;
return <
");
} else {
$r->print("$lt{'usrch'}
");
}
$r->print(&entry_form($srch->{'srchdomain'},$srch,undef,$context,undef,$crstype));
if ($readonly) {
$r->print(''.$lt{'suvr'}.'
');
} else {
$r->print(''.$lt{'usel'}.'
');
}
} elsif ($env{'form.action'} eq 'singlestudent') {
$r->print($jscript."");
if ($crstype eq 'Community') {
$r->print($lt{'memsrch'});
} else {
$r->print($lt{'stusrch'});
}
$r->print("
");
$r->print(&entry_form($srch->{'srchdomain'},$srch,undef,$context,undef,$crstype));
$r->print('');
if ($crstype eq 'Community') {
$r->print($lt{'memsel'});
} else {
$r->print($lt{'stusel'});
}
$r->print('
');
} elsif ($env{'form.action'} eq 'accesslogs') {
$r->print("$lt{'srcva'}
");
$r->print(&entry_form($srch->{'srchdomain'},$srch,undef,'accesslogs',undef,undef,1));
$r->print(''.$lt{'vacsel'}.'
');
}
}
$r->print('
';
}
$response .= '
';
$env{'form.phase'} = '';
&print_username_entry_form($r,$context,$response,undef,undef,$crstype,$brcrum);
return;
}
$newuser = 1;
my $checkhash;
my $checks = { 'username' => 1 };
$checkhash->{$ccuname.':'.$ccdomain} = { 'newuser' => $newuser };
&Apache::loncommon::user_rule_check($checkhash,$checks,
\%alerts,\%rulematch,\%inst_results,\%curr_rules,\%got_rules);
if (ref($alerts{'username'}) eq 'HASH') {
if (ref($alerts{'username'}{$ccdomain}) eq 'HASH') {
my $domdesc =
&Apache::lonnet::domain($ccdomain,'description');
if ($alerts{'username'}{$ccdomain}{$ccuname}) {
my $userchkmsg;
if (ref($curr_rules{$ccdomain}) eq 'HASH') {
$userchkmsg =
&Apache::loncommon::instrule_disallow_msg('username',
$domdesc,1).
&Apache::loncommon::user_rule_formats($ccdomain,
$domdesc,$curr_rules{$ccdomain}{'username'},
'username');
}
$env{'form.phase'} = '';
&print_username_entry_form($r,$context,$userchkmsg,undef,undef,$crstype,$brcrum);
return;
}
}
}
} else {
$newuser = 0;
}
if ($response) {
$response = '
'.$response;
}
my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
my $dc_setcourse_code = '';
my $nondc_setsection_code = '';
my %loaditem;
my $groupslist = &Apache::lonuserutils::get_groupslist();
my $js = &validation_javascript($context,$ccdomain,$pjump_def,$crstype,
$groupslist,$newuser,$formname,\%loaditem);
my %breadcrumb_text = &singleuser_breadcrumb($crstype,$context,$ccdomain);
my $helpitem = 'Course_Change_Privileges';
if ($env{'form.action'} eq 'singlestudent') {
$helpitem = 'Course_Add_Student';
}
push (@{$brcrum},
{href => "javascript:backPage($form)",
text => $breadcrumb_text{'search'},
faq => 282,
bug => 'Instructor Interface',});
if ($env{'form.phase'} eq 'userpicked') {
push(@{$brcrum},
{href => "javascript:backPage($form,'get_user_info','select')",
text => $breadcrumb_text{'userpicked'},
faq => 282,
bug => 'Instructor Interface',});
}
push(@{$brcrum},
{href => "javascript:backPage($form,'$env{'form.phase'}','modify')",
text => $breadcrumb_text{'modify'},
faq => 282,
bug => 'Instructor Interface',
help => $helpitem});
my $args = {'add_entries' => \%loaditem,
'bread_crumbs' => $brcrum,
'bread_crumbs_component' => 'User Management'};
if ($env{'form.popup'}) {
$args->{'no_nav_bar'} = 1;
}
my $start_page =
&Apache::loncommon::start_page('User Management',$js,$args);
my $forminfo =<<"ENDFORMINFO";
');
return;
}
sub singleuser_breadcrumb {
my ($crstype,$context,$domain) = @_;
my %breadcrumb_text;
if ($env{'form.action'} eq 'singlestudent') {
if ($crstype eq 'Community') {
$breadcrumb_text{'search'} = 'Enroll a member';
} else {
$breadcrumb_text{'search'} = 'Enroll a student';
}
$breadcrumb_text{'userpicked'} = 'Select a user';
$breadcrumb_text{'modify'} = 'Set section/dates';
} elsif ($env{'form.action'} eq 'accesslogs') {
$breadcrumb_text{'search'} = 'View access logs for a user';
$breadcrumb_text{'userpicked'} = 'Select a user';
$breadcrumb_text{'activity'} = 'Activity';
} elsif (($env{'form.action'} eq 'singleuser') && ($context eq 'domain') &&
(!&Apache::lonnet::allowed('mau',$domain))) {
$breadcrumb_text{'search'} = "View user's roles";
$breadcrumb_text{'userpicked'} = 'Select a user';
$breadcrumb_text{'modify'} = 'User roles';
} else {
$breadcrumb_text{'search'} = 'Create/modify a user';
$breadcrumb_text{'userpicked'} = 'Select a user';
$breadcrumb_text{'modify'} = 'Set user role';
}
return %breadcrumb_text;
}
sub date_sections_select {
my ($context,$newuser,$formname,$permission,$crstype,$ccuname,$ccdomain,
$showcredits) = @_;
my $credits;
if ($showcredits) {
my $defaultcredits = &Apache::lonuserutils::get_defaultcredits();
$credits = &get_user_credits($ccuname,$ccdomain,$defaultcredits);
if ($credits eq '') {
$credits = $defaultcredits;
}
}
my $cid = $env{'request.course.id'};
my ($cnum,$cdom) = &Apache::lonuserutils::get_course_identity($cid);
my $date_table = ''.&mt('Starting and Ending Dates').'
'."\n".
&Apache::lonuserutils::date_setting_table(undef,undef,$context,
undef,$formname,$permission);
my $rowtitle = 'Section';
my $secbox = ''.&mt('Section and Credits').'
'."\n".
&Apache::lonuserutils::section_picker($cdom,$cnum,'st',$rowtitle,
$permission,$context,'',$crstype,
$showcredits,$credits);
my $output = $date_table.$secbox;
return $output;
}
sub validation_javascript {
my ($context,$ccdomain,$pjump_def,$crstype,$groupslist,$newuser,$formname,
$loaditem) = @_;
my $dc_setcourse_code = '';
my $nondc_setsection_code = '';
if ($context eq 'domain') {
my $dcdom = $env{'request.role.domain'};
$loaditem->{'onload'} = "document.cu.coursedesc.value='';";
$dc_setcourse_code =
&Apache::lonuserutils::dc_setcourse_js('cu','singleuser',$context);
} else {
my $checkauth;
if (($newuser) || (&Apache::lonnet::allowed('mau',$ccdomain))) {
$checkauth = 1;
}
if ($context eq 'course') {
$nondc_setsection_code =
&Apache::lonuserutils::setsections_javascript($formname,$groupslist,
undef,$checkauth,
$crstype);
}
if ($checkauth) {
$nondc_setsection_code .=
&Apache::lonuserutils::verify_authen($formname,$context);
}
}
my $js = &user_modification_js($pjump_def,$dc_setcourse_code,
$nondc_setsection_code,$groupslist);
my ($jsback,$elements) = &crumb_utilities();
$js .= "\n".
''."\n";
return $js;
}
sub display_existing_roles {
my ($r,$ccuname,$ccdomain,$inccourses,$context,$roledom,$crstype,
$showcredits,$statuses) = @_;
my $now=time;
my $showall = 1;
my ($showexpired,$showactive);
if ((ref($statuses) eq 'ARRAY') && (@{$statuses} > 0)) {
$showall = 0;
if (grep(/^expired$/,@{$statuses})) {
$showexpired = 1;
}
if (grep(/^active$/,@{$statuses})) {
$showactive = 1;
}
if ($showexpired && $showactive) {
$showall = 1;
}
}
my %lt=&Apache::lonlocal::texthash(
'rer' => "Existing Roles",
'rev' => "Revoke",
'del' => "Delete",
'ren' => "Re-Enable",
'rol' => "Role",
'ext' => "Extent",
'crd' => "Credits",
'sta' => "Start",
'end' => "End",
);
my (%rolesdump,%roletext,%sortrole,%roleclass,%rolepriv);
if ($context eq 'course' || $context eq 'author') {
my @roles = &Apache::lonuserutils::roles_by_context($context,1,$crstype);
my %roleshash =
&Apache::lonnet::get_my_roles($ccuname,$ccdomain,'userroles',
['active','previous','future'],\@roles,$roledom,1);
foreach my $key (keys(%roleshash)) {
my ($start,$end) = split(':',$roleshash{$key});
next if ($start eq '-1' || $end eq '-1');
my ($rnum,$rdom,$role,$sec) = split(':',$key);
if ($context eq 'course') {
next unless (($rnum eq $env{'course.'.$env{'request.course.id'}.'.num'})
&& ($rdom eq $env{'course.'.$env{'request.course.id'}.'.domain'}));
} elsif ($context eq 'author') {
next unless (($rnum eq $env{'user.name'}) && ($rdom eq $env{'request.role.domain'}));
}
my ($newkey,$newvalue,$newrole);
$newkey = '/'.$rdom.'/'.$rnum;
if ($sec ne '') {
$newkey .= '/'.$sec;
}
$newvalue = $role;
if ($role =~ /^cr/) {
$newrole = 'cr';
} else {
$newrole = $role;
}
$newkey .= '_'.$newrole;
if ($start ne '' && $end ne '') {
$newvalue .= '_'.$end.'_'.$start;
} elsif ($end ne '') {
$newvalue .= '_'.$end;
}
$rolesdump{$newkey} = $newvalue;
}
} else {
%rolesdump=&Apache::lonnet::dump('roles',$ccdomain,$ccuname);
}
# Build up table of user roles to allow revocation and re-enabling of roles.
my ($tmp) = keys(%rolesdump);
return if ($tmp =~ /^(con_lost|error)/i);
foreach my $area (sort { my $a1=join('_',(split('_',$a))[1,0]);
my $b1=join('_',(split('_',$b))[1,0]);
return $a1 cmp $b1;
} keys(%rolesdump)) {
next if ($area =~ /^rolesdef/);
my $envkey=$area;
my $role = $rolesdump{$area};
my $thisrole=$area;
$area =~ s/\_\w\w$//;
my ($role_code,$role_end_time,$role_start_time) =
split(/_/,$role);
my $active=1;
$active=0 if (($role_end_time) && ($now>$role_end_time));
if ($active) {
next unless($showall || $showactive);
} else {
next unless($showall || $showexpired);
}
# Is this a custom role? Get role owner and title.
my ($croleudom,$croleuname,$croletitle)=
($role_code=~m{^cr/($match_domain)/($match_username)/(\w+)$});
my $allowed=0;
my $delallowed=0;
my $sortkey=$role_code;
my $class='Unknown';
my $credits='';
my $csec;
if ($area =~ m{^/($match_domain)/($match_courseid)}) {
$class='Course';
my ($coursedom,$coursedir) = ($1,$2);
my $cid = $1.'_'.$2;
# $1.'_'.$2 is the course id (eg. 103_12345abcef103l3).
next if ($envkey =~ m{^/$match_domain/$match_courseid/[A-Za-z0-9]+_gr$});
my %coursedata=
&Apache::lonnet::coursedescription($cid);
if ($coursedir =~ /^$match_community$/) {
$class='Community';
}
$sortkey.="\0$coursedom";
my $carea;
if (defined($coursedata{'description'})) {
$carea=$coursedata{'description'}.
'
'.&mt('Domain').': '.$coursedom.(' 'x8).
&Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$coursedir,$coursedom);
$sortkey.="\0".$coursedata{'description'};
} else {
if ($class eq 'Community') {
$carea=&mt('Unavailable community').': '.$area;
$sortkey.="\0".&mt('Unavailable community').': '.$area;
} else {
$carea=&mt('Unavailable course').': '.$area;
$sortkey.="\0".&mt('Unavailable course').': '.$area;
}
}
$sortkey.="\0$coursedir";
$inccourses->{$cid}=1;
if (($showcredits) && ($class eq 'Course') && ($role_code eq 'st')) {
my $defaultcredits = $coursedata{'internal.defaultcredits'};
$credits =
&get_user_credits($ccuname,$ccdomain,$defaultcredits,
$coursedom,$coursedir);
if ($credits eq '') {
$credits = $defaultcredits;
}
}
if ((&Apache::lonnet::allowed('c'.$role_code,$coursedom.'/'.$coursedir)) ||
(&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
$allowed=1;
}
unless ($allowed) {
my $isowner = &Apache::lonuserutils::is_courseowner($cid,$coursedata{'internal.courseowner'});
if ($isowner) {
if (($role_code eq 'co') && ($class eq 'Community')) {
$allowed = 1;
} elsif (($role_code eq 'cc') && ($class eq 'Course')) {
$allowed = 1;
}
}
}
if ((&Apache::lonnet::allowed('dro',$coursedom)) ||
(&Apache::lonnet::allowed('dro',$ccdomain))) {
$delallowed=1;
}
# - custom role. Needs more info, too
if ($croletitle) {
if (&Apache::lonnet::allowed('ccr',$coursedom.'/'.$coursedir)) {
$allowed=1;
$thisrole.='.'.$role_code;
}
}
if ($area=~m{^/($match_domain/$match_courseid/(\w+))}) {
$csec = $2;
$carea.='
'.&mt('Section: [_1]',$csec);
$sortkey.="\0$csec";
if (!$allowed) {
if ($env{'request.course.sec'} eq $csec) {
if (&Apache::lonnet::allowed('c'.$role_code,$1)) {
$allowed = 1;
}
}
}
}
$area=$carea;
} else {
$sortkey.="\0".$area;
# Determine if current user is able to revoke privileges
if ($area=~m{^/($match_domain)/}) {
if ((&Apache::lonnet::allowed('c'.$role_code,$1)) ||
(&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
$allowed=1;
}
if (((&Apache::lonnet::allowed('dro',$1)) ||
(&Apache::lonnet::allowed('dro',$ccdomain))) &&
($role_code ne 'dc')) {
$delallowed=1;
}
} else {
if (&Apache::lonnet::allowed('c'.$role_code,'/')) {
$allowed=1;
}
}
if ($role_code eq 'ca' || $role_code eq 'au' || $role_code eq 'aa') {
$class='Authoring Space';
} elsif ($role_code eq 'su') {
$class='System';
} else {
$class='Domain';
}
}
if (($role_code eq 'ca') || ($role_code eq 'aa')) {
$area=~m{/($match_domain)/($match_username)};
if (&Apache::lonuserutils::authorpriv($2,$1)) {
$allowed=1;
} else {
$allowed=0;
}
}
my $row = '';
if ($showall) {
$row.= '';
if (($active) && ($allowed)) {
$row.= '';
} else {
if ($active) {
$row.=' ';
} else {
$row.=&mt('expired or revoked');
}
}
$row.=' ';
if ($allowed && !$active) {
$row.= '';
} else {
$row.=' ';
}
$row.=' ';
if ($delallowed) {
$row.= '';
} else {
$row.=' ';
}
$row.= ' ';
}
my $plaintext='';
if (!$croletitle) {
$plaintext=&Apache::lonnet::plaintext($role_code,$class);
if (($showcredits) && ($credits ne '')) {
$plaintext .= '
'.
''.
&mt('Credits: [_1]',$credits).
'';
}
} else {
$plaintext=
&mt('Custom role [_1][_2]defined by [_3]',
'"'.$croletitle.'"',
'
',
$croleuname.':'.$croleudom);
}
$row.= ''.$plaintext.' '.
''.$area.' '.
''.($role_start_time?&Apache::lonlocal::locallocaltime($role_start_time)
: ' ' ).' '.
''.($role_end_time ?&Apache::lonlocal::locallocaltime($role_end_time)
: ' ' ).' ';
$sortrole{$sortkey}=$envkey;
$roletext{$envkey}=$row;
$roleclass{$envkey}=$class;
if ($allowed) {
$rolepriv{$envkey}='edit';
} else {
if ($context eq 'domain') {
if ((&Apache::lonnet::allowed('vur',$ccdomain)) &&
($envkey=~m{^/$ccdomain/})) {
$rolepriv{$envkey}='view';
}
} elsif ($context eq 'course') {
if ((&Apache::lonnet::allowed('vcl',$env{'request.course.id'})) ||
($env{'request.course.sec'} && ($env{'request.course.sec'} eq $csec) &&
&Apache::lonnet::allowed('vcl',$env{'request.course.id'}.'/'.$env{'request.course.sec'}))) {
$rolepriv{$envkey}='view';
}
}
}
} # end of foreach (table building loop)
my $rolesdisplay = 0;
my %output = ();
foreach my $type ('Authoring Space','Course','Community','Domain','System','Unknown') {
$output{$type} = '';
foreach my $which (sort {uc($a) cmp uc($b)} (keys(%sortrole))) {
if ( ($roleclass{$sortrole{$which}} =~ /^\Q$type\E/ ) && ($rolepriv{$sortrole{$which}}) ) {
$output{$type}.=
&Apache::loncommon::start_data_table_row().
$roletext{$sortrole{$which}}.
&Apache::loncommon::end_data_table_row();
}
}
unless($output{$type} eq '') {
$output{$type} = ''.
" ".
$output{$type};
$rolesdisplay = 1;
}
}
if ($rolesdisplay == 1) {
my $contextrole='';
if ($env{'request.course.id'}) {
if (&Apache::loncommon::course_type() eq 'Community') {
$contextrole = &mt('Existing Roles in this Community');
} else {
$contextrole = &mt('Existing Roles in this Course');
}
} elsif ($env{'request.role'} =~ /^au\./) {
$contextrole = &mt('Existing Co-Author Roles in your Authoring Space');
} else {
if ($showall) {
$contextrole = &mt('Existing Roles in this Domain');
} elsif ($showactive) {
$contextrole = &mt('Unexpired Roles in this Domain');
} elsif ($showexpired) {
$contextrole = &mt('Expired or Revoked Roles in this Domain');
}
}
$r->print('".&mt($type)." '.$lt{'cs'}.'
'."\n".
&Apache::loncommon::start_data_table()."\n".
&Apache::loncommon::start_data_table_header_row()."\n".
''.$lt{'act'}.' '.$lt{'rol'}.' '.
''.$lt{'ext'}.' '.$lt{'sta'}.' '.
''.$lt{'end'}.' '."\n".
&Apache::loncommon::end_data_table_header_row()."\n".
&Apache::loncommon::start_data_table_row().'
'.$lt{'cau'}.'
'.$cudom.'_'.$cuname.'
'.$lt{'ssd'}.'
'.$lt{'sed'}.' '."\n".
&Apache::loncommon::end_data_table_row()."\n".
&Apache::loncommon::start_data_table_row()."\n".
'
'.$lt{'caa'}.'
'.$cudom.'_'.$cuname.'
'.$lt{'ssd'}.'
'.$lt{'sed'}.' '."\n".
&Apache::loncommon::end_data_table_row()."\n".
&Apache::loncommon::end_data_table());
} elsif ($env{'request.role'} =~ /^au\./) {
if (!(&Apache::lonuserutils::authorpriv($env{'user.name'},
$env{'request.role.domain'}))) {
$r->print(''.
&mt('You do not have privileges to assign co-author roles.').
'');
} elsif (($env{'user.name'} eq $ccuname) &&
($env{'user.domain'} eq $ccdomain)) {
$r->print(&mt('Assigning yourself a co-author or assistant co-author role in your own author area in Authoring Space is not permitted'));
}
}
return $addrolesdisplay;;
}
sub new_domain_roles {
my ($r,$ccdomain) = @_;
my $addrolesdisplay = 0;
#
# Domain level
#
my $num_domain_level = 0;
my $domaintext =
''.&mt('Domain Level').'
'.
&Apache::loncommon::start_data_table().
&Apache::loncommon::start_data_table_header_row().
''.&mt('Activate').' '.&mt('Role').' '.
&mt('Extent').' '.
''.&mt('Start').' '.&mt('End').' '.
&Apache::loncommon::end_data_table_header_row();
my @allroles = &Apache::lonuserutils::roles_by_context('domain');
foreach my $thisdomain (sort(&Apache::lonnet::all_domains())) {
foreach my $role (@allroles) {
next if ($role eq 'ad');
next if (($role eq 'au') && ($ccdomain ne $thisdomain));
if (&Apache::lonnet::allowed('c'.$role,$thisdomain)) {
my $plrole=&Apache::lonnet::plaintext($role);
my %lt=&Apache::lonlocal::texthash(
'ssd' => "Set Start Date",
'sed' => "Set End Date"
);
$num_domain_level ++;
$domaintext .=
&Apache::loncommon::start_data_table_row().
'
'.$plrole.'
'.$thisdomain.'
'.$lt{'ssd'}.'
'.$lt{'sed'}.' '.
&Apache::loncommon::end_data_table_row();
}
}
}
$domaintext.= &Apache::loncommon::end_data_table();
if ($num_domain_level > 0) {
$r->print($domaintext);
$addrolesdisplay = 1;
}
return $addrolesdisplay;
}
sub user_authentication {
my ($ccuname,$ccdomain,$formname) = @_;
my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);
my $outcome;
my %lt=&Apache::lonlocal::texthash(
'err' => "ERROR",
'uuas' => "This user has an unrecognized authentication scheme",
'adcs' => "Please alert a domain coordinator of this situation",
'sldb' => "Please specify login data below",
'ld' => "Login Data"
);
# Check for a bad authentication type
if ($currentauth !~ /^(krb4|krb5|unix|internal|localauth):/) {
# bad authentication scheme
if (&Apache::lonnet::allowed('mau',$ccdomain)) {
&initialize_authen_forms($ccdomain,$formname);
my $choices = &Apache::lonuserutils::set_login($ccdomain,$authformkrb,$authformint,$authformloc);
$outcome = <$lt{'ld'}
$choices
ENDBADAUTH
} else {
# This user is not allowed to modify the user's
# authentication scheme, so just notify them of the problem
$outcome = <'.$lt{'ld'}.'
'.
&Apache::loncommon::start_data_table().
&Apache::loncommon::start_data_table_row().
''.$authformnop;
if (($can_modify) && (&Apache::lonnet::allowed('mau',$ccdomain))) {
$outcome .= ' '."\n".
&Apache::loncommon::end_data_table_row().
&Apache::loncommon::start_data_table_row().
''.$authformcurrent.' '.
&Apache::loncommon::end_data_table_row()."\n";
} else {
$outcome .= ' ('.$authformcurrent.')'.
&Apache::loncommon::end_data_table_row()."\n";
}
if (&Apache::lonnet::allowed('mau',$ccdomain)) {
foreach my $item (@authform_others) {
$outcome .= &Apache::loncommon::start_data_table_row().
''.$item.' '.
&Apache::loncommon::end_data_table_row()."\n";
}
}
$outcome .= &Apache::loncommon::end_data_table();
} else {
if (&Apache::lonnet::allowed('udp',$ccdomain)) {
# Current user has rights to view domain preferences for user's domain
my $result;
if ($currentauth =~ /^krb(4|5):([^:]*)$/) {
my ($krbver,$krbrealm) = ($1,$2);
if ($krbrealm eq '') {
$result = &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
} else {
$result = &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
$krbrealm,$krbver);
}
} elsif ($currentauth =~ /^internal:/) {
$result = &mt('Currently internally authenticated.');
} elsif ($currentauth =~ /^localauth:/) {
$result = &mt('Currently using local (institutional) authentication.');
} elsif ($currentauth =~ /^unix:/) {
$result = &mt('Currently Filesystem Authenticated.');
}
$outcome = ''.$lt{'ld'}.'
'.
&Apache::loncommon::start_data_table().
&Apache::loncommon::start_data_table_row().
''.$result.' '.
&Apache::loncommon::end_data_table_row()."\n".
&Apache::loncommon::end_data_table();
} elsif (&Apache::lonnet::allowed('mau',$env{'request.role.domain'})) {
my %lt=&Apache::lonlocal::texthash(
'ccld' => "Change Current Login Data",
'yodo' => "You do not have privileges to modify the authentication configuration for this user.",
'ifch' => "If a change is required, contact a domain coordinator for the domain",
);
$outcome .= <
';
}
return ($authformcurrent,$show_override_msg,@authform_others);
}
sub personal_data_display {
my ($ccuname,$ccdomain,$newuser,$context,$inst_results,$rolesarray,
$now,$captchaform,$emailusername,$usertype) = @_;
my ($output,%userenv,%canmodify,%canmodify_status);
my @userinfo = ('firstname','middlename','lastname','generation',
'permanentemail','id');
my $rowcount = 0;
my $editable = 0;
my %textboxsize = (
firstname => '15',
middlename => '15',
lastname => '15',
generation => '5',
permanentemail => '25',
id => '15',
);
my %lt=&Apache::lonlocal::texthash(
'pd' => "Personal Data",
'firstname' => "First Name",
'middlename' => "Middle Name",
'lastname' => "Last Name",
'generation' => "Generation",
'permanentemail' => "Permanent e-mail address",
'id' => "Student/Employee ID",
'lg' => "Login Data",
'inststatus' => "Affiliation",
'email' => 'E-mail address',
'valid' => 'Validation',
);
%canmodify_status =
&Apache::lonuserutils::can_modify_userinfo($context,$ccdomain,
['inststatus'],$rolesarray);
if (!$newuser) {
# Get the users information
%userenv = &Apache::lonnet::get('environment',
['firstname','middlename','lastname','generation',
'permanentemail','id','inststatus'],$ccdomain,$ccuname);
%canmodify =
&Apache::lonuserutils::can_modify_userinfo($context,$ccdomain,
\@userinfo,$rolesarray);
} elsif ($context eq 'selfcreate') {
if ($newuser eq 'email') {
if (ref($emailusername) eq 'HASH') {
if (ref($emailusername->{$usertype}) eq 'HASH') {
my ($infofields,$infotitles) = &Apache::loncommon::emailusername_info();
@userinfo = ();
if ((ref($infofields) eq 'ARRAY') && (ref($infotitles) eq 'HASH')) {
foreach my $field (@{$infofields}) {
if ($emailusername->{$usertype}->{$field}) {
push(@userinfo,$field);
$canmodify{$field} = 1;
unless ($textboxsize{$field}) {
$textboxsize{$field} = 25;
}
unless ($lt{$field}) {
$lt{$field} = $infotitles->{$field};
}
if ($emailusername->{$usertype}->{$field} eq 'required') {
$lt{$field} .= '*';
}
}
}
}
}
}
} else {
%canmodify = &selfcreate_canmodify($context,$ccdomain,\@userinfo,
$inst_results,$rolesarray);
}
}
my $genhelp=&Apache::loncommon::help_open_topic('Generation');
$output = ' '."\n".
''.$authformcurrent.
' '.
''.&mt('Currently in use').' '.
''.
&mt('will override current values').
' '.$lt{'pd'}.'
'.
&Apache::lonhtmlcommon::start_pick_box();
if (($context eq 'selfcreate') && ($newuser eq 'email')) {
$output .= &Apache::lonhtmlcommon::row_title($lt{'email'}.'*',undef,
'LC_oddrow_value')."\n".
'';
$rowcount ++;
$output .= &Apache::lonhtmlcommon::row_closure(1);
my $upassone = '';
my $upasstwo = '';
$output .= &Apache::lonhtmlcommon::row_title(&mt('Password').'*',
'LC_pick_box_title',
'LC_oddrow_value')."\n".
$upassone."\n".
&Apache::lonhtmlcommon::row_closure(1)."\n".
&Apache::lonhtmlcommon::row_title(&mt('Confirm password').'*',
'LC_pick_box_title',
'LC_oddrow_value')."\n".
$upasstwo.
&Apache::lonhtmlcommon::row_closure()."\n";
}
foreach my $item (@userinfo) {
my $rowtitle = $lt{$item};
my $hiderow = 0;
if ($item eq 'generation') {
$rowtitle = $genhelp.$rowtitle;
}
my $row = &Apache::lonhtmlcommon::row_title($rowtitle,undef,'LC_oddrow_value')."\n";
if ($newuser) {
if (ref($inst_results) eq 'HASH') {
if ($inst_results->{$item} ne '') {
$row .= ''.$inst_results->{$item};
} else {
if ($context eq 'selfcreate') {
if ($canmodify{$item}) {
$row .= '';
$editable ++;
} else {
$hiderow = 1;
}
} else {
$row .= '';
}
}
} else {
if ($context eq 'selfcreate') {
if ($canmodify{$item}) {
if ($newuser eq 'email') {
$row .= '';
} else {
$row .= '';
}
$editable ++;
} else {
$hiderow = 1;
}
} else {
$row .= '';
}
}
} else {
if ($canmodify{$item}) {
$row .= '';
if (($item eq 'id') && (!$newuser)) {
$row .= '
'.&Apache::lonuserutils::forceid_change($context);
}
} else {
$row .= $userenv{$item};
}
}
$row .= &Apache::lonhtmlcommon::row_closure(1);
if (!$hiderow) {
$output .= $row;
$rowcount ++;
}
}
if (($canmodify_status{'inststatus'}) || ($context ne 'selfcreate')) {
my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($ccdomain);
if (ref($types) eq 'ARRAY') {
if (@{$types} > 0) {
my ($hiderow,$shown);
if ($canmodify_status{'inststatus'}) {
$shown = &pick_inst_statuses($userenv{'inststatus'},$usertypes,$types);
} else {
if ($userenv{'inststatus'} eq '') {
$hiderow = 1;
} else {
my @showitems;
foreach my $item ( map { &unescape($_); } split(':',$userenv{'inststatus'})) {
if (exists($usertypes->{$item})) {
push(@showitems,$usertypes->{$item});
} else {
push(@showitems,$item);
}
}
if (@showitems) {
$shown = join(', ',@showitems);
} else {
$hiderow = 1;
}
}
}
if (!$hiderow) {
my $row = &Apache::lonhtmlcommon::row_title(&mt('Affiliations'),undef,'LC_oddrow_value')."\n".
$shown.&Apache::lonhtmlcommon::row_closure(1);
if ($context eq 'selfcreate') {
$rowcount ++;
}
$output .= $row;
}
}
}
}
if (($context eq 'selfcreate') && ($newuser eq 'email')) {
if ($captchaform) {
$output .= &Apache::lonhtmlcommon::row_title($lt{'valid'}.'*',
'LC_pick_box_title')."\n".
$captchaform."\n".'
'.
&Apache::lonhtmlcommon::row_closure(1);
$rowcount ++;
}
my $submit_text = &mt('Create account');
$output .= &Apache::lonhtmlcommon::row_title()."\n".
'
'.
''.
&Apache::lonhtmlcommon::row_closure(1);
}
$output .= &Apache::lonhtmlcommon::end_pick_box();
if (wantarray) {
if ($context eq 'selfcreate') {
return($output,$rowcount,$editable);
} else {
return $output;
}
} else {
return $output;
}
}
sub pick_inst_statuses {
my ($curr,$usertypes,$types) = @_;
my ($output,$rem,@currtypes);
if ($curr ne '') {
@currtypes = map { &unescape($_); } split(/:/,$curr);
}
my $numinrow = 2;
if (ref($types) eq 'ARRAY') {
$output = '';
my $lastcolspan;
for (my $i=0; $i<@{$types}; $i++) {
if (defined($usertypes->{$types->[$i]})) {
my $rem = $i%($numinrow);
if ($rem == 0) {
if ($i<@{$types}-1) {
if ($i > 0) {
$output .= '';
}
$output .= '
';
}
return $output;
}
sub selfcreate_canmodify {
my ($context,$dom,$userinfo,$inst_results,$rolesarray) = @_;
if (ref($inst_results) eq 'HASH') {
my @inststatuses = &get_inststatuses($inst_results);
if (@inststatuses == 0) {
@inststatuses = ('default');
}
$rolesarray = \@inststatuses;
}
my %canmodify =
&Apache::lonuserutils::can_modify_userinfo($context,$dom,$userinfo,
$rolesarray);
return %canmodify;
}
sub get_inststatuses {
my ($insthashref) = @_;
my @inststatuses = ();
if (ref($insthashref) eq 'HASH') {
if (ref($insthashref->{'inststatus'}) eq 'ARRAY') {
@inststatuses = @{$insthashref->{'inststatus'}};
}
}
return @inststatuses;
}
# ================================================================= Phase Three
sub update_user_data {
my ($r,$context,$crstype,$brcrum,$showcredits) = @_;
my $uhome=&Apache::lonnet::homeserver($env{'form.ccuname'},
$env{'form.ccdomain'});
# Error messages
my $error = ''.&mt('Error').': ';
my $end = '';
}
} elsif ($i==@{$types}-1) {
my $colsleft = $numinrow - $rem;
if ($colsleft > 1) {
$lastcolspan = ' colspan="'.$colsleft.'"';
}
}
my $check = ' ';
if (grep(/^\Q$types->[$i]\E$/,@currtypes)) {
$check = ' checked="checked" ';
}
$output .= ' '.
' ';
}
}
$output .= '
';
my $rtnlink = ''.
&mt('Return to previous page').''.
&Apache::loncommon::end_page();
my $now = time;
my $title;
if (exists($env{'form.makeuser'})) {
$title='Set Privileges for New User';
} else {
$title='Modify User Privileges';
}
my $newuser = 0;
my ($jsback,$elements) = &crumb_utilities();
my $jscript = ''."\n";
my %breadcrumb_text = &singleuser_breadcrumb($crstype,$context,$env{'form.ccdomain'});
push (@{$brcrum},
{href => "javascript:backPage(document.userupdate)",
text => $breadcrumb_text{'search'},
faq => 282,
bug => 'Instructor Interface',}
);
if ($env{'form.prevphase'} eq 'userpicked') {
push(@{$brcrum},
{href => "javascript:backPage(document.userupdate,'get_user_info','select')",
text => $breadcrumb_text{'userpicked'},
faq => 282,
bug => 'Instructor Interface',});
}
my $helpitem = 'Course_Change_Privileges';
if ($env{'form.action'} eq 'singlestudent') {
$helpitem = 'Course_Add_Student';
}
push(@{$brcrum},
{href => "javascript:backPage(document.userupdate,'$env{'form.prevphase'}','modify')",
text => $breadcrumb_text{'modify'},
faq => 282,
bug => 'Instructor Interface',},
{href => "/adm/createuser",
text => "Result",
faq => 282,
bug => 'Instructor Interface',
help => $helpitem});
my $args = {bread_crumbs => $brcrum,
bread_crumbs_component => 'User Management'};
if ($env{'form.popup'}) {
$args->{'no_nav_bar'} = 1;
}
$r->print(&Apache::loncommon::start_page($title,$jscript,$args));
$r->print(&update_result_form($uhome));
# Check Inputs
if (! $env{'form.ccuname'} ) {
$r->print($error.&mt('No login name specified').'.'.$end.$rtnlink);
return;
}
if ( $env{'form.ccuname'} ne
&LONCAPA::clean_username($env{'form.ccuname'}) ) {
$r->print($error.&mt('Invalid login name.').' '.
&mt('Only letters, numbers, periods, dashes, @, and underscores are valid.').
$end.$rtnlink);
return;
}
if (! $env{'form.ccdomain'} ) {
$r->print($error.&mt('No domain specified').'.'.$end.$rtnlink);
return;
}
if ( $env{'form.ccdomain'} ne
&LONCAPA::clean_domain($env{'form.ccdomain'}) ) {
$r->print($error.&mt('Invalid domain name.').' '.
&mt('Only letters, numbers, periods, dashes, and underscores are valid.').
$end.$rtnlink);
return;
}
if ($uhome eq 'no_host') {
$newuser = 1;
}
if (! exists($env{'form.makeuser'})) {
# Modifying an existing user, so check the validity of the name
if ($uhome eq 'no_host') {
$r->print(
$error
.''.&mt('User [_1] in domain [_2]',
$env{'form.ccuname'}.' ('.&Apache::loncommon::plainname($env{'form.ccuname'},
$env{'form.ccdomain'}).')', $env{'form.ccdomain'}).'
');
my %prog_state = &Apache::lonhtmlcommon::Create_PrgWin($r,2);
my (%alerts,%rulematch,%inst_results,%curr_rules);
my @userinfo = ('firstname','middlename','lastname','generation','permanentemail','id');
my @usertools = ('aboutme','blog','webdav','portfolio');
my @requestcourses = ('official','unofficial','community','textbook');
my @requestauthor = ('requestauthor');
my ($othertitle,$usertypes,$types) =
&Apache::loncommon::sorted_inst_types($env{'form.ccdomain'});
my %canmodify_status =
&Apache::lonuserutils::can_modify_userinfo($context,$env{'form.ccdomain'},
['inststatus']);
if ($env{'form.makeuser'}) {
$r->print(''.&mt('Creating new account.').'
');
# Check for the authentication mode and password
if (! $amode || ! $genpwd) {
$r->print($error.&mt('Invalid login mode or password').$end.$rtnlink);
return;
}
# Determine desired host
my $desiredhost = $env{'form.hserver'};
if (lc($desiredhost) eq 'default') {
$desiredhost = undef;
} else {
my %home_servers =
&Apache::lonnet::get_servers($env{'form.ccdomain'},'library');
if (! exists($home_servers{$desiredhost})) {
$r->print($error.&mt('Invalid home server specified').$end.$rtnlink);
return;
}
}
# Check ID format
my %checkhash;
my %checks = ('id' => 1);
%{$checkhash{$env{'form.ccuname'}.':'.$env{'form.ccdomain'}}} = (
'newuser' => $newuser,
'id' => $env{'form.cid'},
);
if ($env{'form.cid'} ne '') {
&Apache::loncommon::user_rule_check(\%checkhash,\%checks,\%alerts,
\%rulematch,\%inst_results,\%curr_rules);
if (ref($alerts{'id'}) eq 'HASH') {
if (ref($alerts{'id'}{$env{'form.ccdomain'}}) eq 'HASH') {
my $domdesc =
&Apache::lonnet::domain($env{'form.ccdomain'},'description');
if ($alerts{'id'}{$env{'form.ccdomain'}}{$env{'form.cid'}}) {
my $userchkmsg;
if (ref($curr_rules{$env{'form.ccdomain'}}) eq 'HASH') {
$userchkmsg =
&Apache::loncommon::instrule_disallow_msg('id',
$domdesc,1).
&Apache::loncommon::user_rule_formats($env{'form.ccdomain'},
$domdesc,$curr_rules{$env{'form.ccdomain'}}{'id'},'id');
}
$r->print($error.&mt('Invalid ID format').$end.
$userchkmsg.$rtnlink);
return;
}
}
}
}
&Apache::lonhtmlcommon::Increment_PrgWin($r, \%prog_state);
# Call modifyuser
my $result = &Apache::lonnet::modifyuser
($env{'form.ccdomain'},$env{'form.ccuname'},$env{'form.cid'},
$amode,$genpwd,$env{'form.cfirstname'},
$env{'form.cmiddlename'},$env{'form.clastname'},
$env{'form.cgeneration'},undef,$desiredhost,
$env{'form.cpermanentemail'});
$r->print(&mt('Generating user').': '.$result);
$uhome = &Apache::lonnet::homeserver($env{'form.ccuname'},
$env{'form.ccdomain'});
my (%changeHash,%newcustom,%changed,%changedinfo);
if ($uhome ne 'no_host') {
if ($context eq 'domain') {
foreach my $name ('portfolio','author') {
if ($env{'form.custom_'.$name.'quota'} == 1) {
if ($env{'form.'.$name.'quota'} eq '') {
$newcustom{$name.'quota'} = 0;
} else {
$newcustom{$name.'quota'} = $env{'form.'.$name.'quota'};
$newcustom{$name.'quota'} =~ s/[^\d\.]//g;
}
if ("a_admin($newcustom{$name.'quota'},\%changeHash,$name)) {
$changed{$name.'quota'} = 1;
}
}
}
foreach my $item (@usertools) {
if ($env{'form.custom'.$item} == 1) {
$newcustom{$item} = $env{'form.tools_'.$item};
$changed{$item} = &tool_admin($item,$newcustom{$item},
\%changeHash,'tools');
}
}
foreach my $item (@requestcourses) {
if ($env{'form.custom'.$item} == 1) {
$newcustom{$item} = $env{'form.crsreq_'.$item};
if ($env{'form.crsreq_'.$item} eq 'autolimit') {
$newcustom{$item} .= '=';
$env{'form.crsreq_'.$item.'_limit'} =~ s/\D+//g;
if ($env{'form.crsreq_'.$item.'_limit'}) {
$newcustom{$item} .= $env{'form.crsreq_'.$item.'_limit'};
}
}
$changed{$item} = &tool_admin($item,$newcustom{$item},
\%changeHash,'requestcourses');
}
}
if ($env{'form.customrequestauthor'} == 1) {
$newcustom{'requestauthor'} = $env{'form.requestauthor'};
$changed{'requestauthor'} = &tool_admin('requestauthor',
$newcustom{'requestauthor'},
\%changeHash,'requestauthor');
}
}
if ($canmodify_status{'inststatus'}) {
if (exists($env{'form.inststatus'})) {
my @inststatuses = &Apache::loncommon::get_env_multiple('form.inststatus');
if (@inststatuses > 0) {
$changeHash{'inststatus'} = join(',',@inststatuses);
$changed{'inststatus'} = $changeHash{'inststatus'};
}
}
}
if (keys(%changed)) {
foreach my $item (@userinfo) {
$changeHash{$item} = $env{'form.c'.$item};
}
my $chgresult =
&Apache::lonnet::put('environment',\%changeHash,
$env{'form.ccdomain'},$env{'form.ccuname'});
}
}
$r->print('
'.&mt('Home server').': '.$uhome.' '.
&Apache::lonnet::hostname($uhome));
} elsif (($env{'form.login'} ne 'nochange') &&
($env{'form.login'} ne '' )) {
# Modify user privileges
if (! $amode || ! $genpwd) {
$r->print($error.'Invalid login mode or password'.$end.$rtnlink);
return;
}
# Only allow authentication modification if the person has authority
if (&Apache::lonnet::allowed('mau',$env{'form.ccdomain'})) {
$r->print('Modifying authentication: '.
&Apache::lonnet::modifyuserauth(
$env{'form.ccdomain'},$env{'form.ccuname'},
$amode,$genpwd));
$r->print('
'.&mt('Home server').': '.&Apache::lonnet::homeserver
($env{'form.ccuname'},$env{'form.ccdomain'}));
} else {
# Okay, this is a non-fatal error.
$r->print($error.&mt('You do not have the authority to modify this users authentication information.').$end);
}
}
$r->rflush(); # Finish display of header before time consuming actions start
&Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state);
##
my (@userroles,%userupdate,$cnum,$cdom,$defaultcredits,%namechanged);
if ($context eq 'course') {
($cnum,$cdom) =
&Apache::lonuserutils::get_course_identity();
$crstype = &Apache::loncommon::course_type($cdom.'_'.$cnum);
if ($showcredits) {
$defaultcredits = &Apache::lonuserutils::get_defaultcredits($cdom,$cnum);
}
}
if (! $env{'form.makeuser'} ) {
# Check for need to change
my %userenv = &Apache::lonnet::get
('environment',['firstname','middlename','lastname','generation',
'id','permanentemail','portfolioquota','authorquota','inststatus',
'tools.aboutme','tools.blog','tools.webdav','tools.portfolio',
'requestcourses.official','requestcourses.unofficial',
'requestcourses.community','requestcourses.textbook',
'reqcrsotherdom.official','reqcrsotherdom.unofficial',
'reqcrsotherdom.community','reqcrsotherdom.textbook',
'requestauthor'],
$env{'form.ccdomain'},$env{'form.ccuname'});
my ($tmp) = keys(%userenv);
if ($tmp =~ /^(con_lost|error)/i) {
%userenv = ();
}
my $no_forceid_alert;
# Check to see if user information can be changed
my %domconfig =
&Apache::lonnet::get_dom('configuration',['usermodification'],
$env{'form.ccdomain'});
my @statuses = ('active','future');
my %roles = &Apache::lonnet::get_my_roles($env{'form.ccuname'},$env{'form.ccdomain'},'userroles',\@statuses,undef,$env{'request.role.domain'});
my ($auname,$audom);
if ($context eq 'author') {
$auname = $env{'user.name'};
$audom = $env{'user.domain'};
}
foreach my $item (keys(%roles)) {
my ($rolenum,$roledom,$role) = split(/:/,$item,-1);
if ($context eq 'course') {
if ($cnum ne '' && $cdom ne '') {
if ($rolenum eq $cnum && $roledom eq $cdom) {
if (!grep(/^\Q$role\E$/,@userroles)) {
push(@userroles,$role);
}
}
}
} elsif ($context eq 'author') {
if ($rolenum eq $auname && $roledom eq $audom) {
if (!grep(/^\Q$role\E$/,@userroles)) {
push(@userroles,$role);
}
}
}
}
if ($env{'form.action'} eq 'singlestudent') {
if (!grep(/^st$/,@userroles)) {
push(@userroles,'st');
}
} else {
# Check for course or co-author roles being activated or re-enabled
if ($context eq 'author' || $context eq 'course') {
foreach my $key (keys(%env)) {
if ($context eq 'author') {
if ($key=~/^form\.act_\Q$audom\E_\Q$auname\E_([^_]+)/) {
if (!grep(/^\Q$1\E$/,@userroles)) {
push(@userroles,$1);
}
} elsif ($key =~/^form\.ren\:\Q$audom\E\/\Q$auname\E_([^_]+)/) {
if (!grep(/^\Q$1\E$/,@userroles)) {
push(@userroles,$1);
}
}
} elsif ($context eq 'course') {
if ($key=~/^form\.act_\Q$cdom\E_\Q$cnum\E_([^_]+)/) {
if (!grep(/^\Q$1\E$/,@userroles)) {
push(@userroles,$1);
}
} elsif ($key =~/^form\.ren\:\Q$cdom\E\/\Q$cnum\E(\/?\w*)_([^_]+)/) {
if (!grep(/^\Q$1\E$/,@userroles)) {
push(@userroles,$1);
}
}
}
}
}
}
#Check to see if we can change personal data for the user
my (@mod_disallowed,@longroles);
foreach my $role (@userroles) {
if ($role eq 'cr') {
push(@longroles,'Custom');
} else {
push(@longroles,&Apache::lonnet::plaintext($role,$crstype));
}
}
my %canmodify = &Apache::lonuserutils::can_modify_userinfo($context,$env{'form.ccdomain'},\@userinfo,\@userroles);
foreach my $item (@userinfo) {
# Strip leading and trailing whitespace
$env{'form.c'.$item} =~ s/(\s+$|^\s+)//g;
if (!$canmodify{$item}) {
if (defined($env{'form.c'.$item})) {
if ($env{'form.c'.$item} ne $userenv{$item}) {
push(@mod_disallowed,$item);
}
}
$env{'form.c'.$item} = $userenv{$item};
}
}
# Check to see if we can change the Student/Employee ID
my $forceid = $env{'form.forceid'};
my $recurseid = $env{'form.recurseid'};
my (%alerts,%rulematch,%idinst_results,%curr_rules,%got_rules);
my %uidhash = &Apache::lonnet::idrget($env{'form.ccdomain'},
$env{'form.ccuname'});
if (($uidhash{$env{'form.ccuname'}}) &&
($uidhash{$env{'form.ccuname'}}!~/error\:/) &&
(!$forceid)) {
if ($env{'form.cid'} ne $uidhash{$env{'form.ccuname'}}) {
$env{'form.cid'} = $userenv{'id'};
$no_forceid_alert = &mt('New student/employee ID does not match existing ID for this user.')
.'
'
.&mt("Change is not permitted without checking the 'Force ID change' checkbox on the previous page.")
.'
'."\n";
}
}
if ($env{'form.cid'} ne $userenv{'id'}) {
my $checkhash;
my $checks = { 'id' => 1 };
$checkhash->{$env{'form.ccuname'}.':'.$env{'form.ccdomain'}} =
{ 'newuser' => $newuser,
'id' => $env{'form.cid'},
};
&Apache::loncommon::user_rule_check($checkhash,$checks,
\%alerts,\%rulematch,\%idinst_results,\%curr_rules,\%got_rules);
if (ref($alerts{'id'}) eq 'HASH') {
if (ref($alerts{'id'}{$env{'form.ccdomain'}}) eq 'HASH') {
$env{'form.cid'} = $userenv{'id'};
}
}
}
my (%quotachanged,%oldquota,%newquota,%olddefquota,%newdefquota,
$oldinststatus,$newinststatus,%oldisdefault,%newisdefault,%oldsettings,
%oldsettingstext,%newsettings,%newsettingstext,@disporder,
%oldsettingstatus,%newsettingstatus);
@disporder = ('inststatus');
if ($env{'request.role.domain'} eq $env{'form.ccdomain'}) {
push(@disporder,'requestcourses','requestauthor');
} else {
push(@disporder,'reqcrsotherdom');
}
push(@disporder,('quota','tools'));
$oldinststatus = $userenv{'inststatus'};
foreach my $name ('portfolio','author') {
($olddefquota{$name},$oldsettingstatus{$name}) =
&Apache::loncommon::default_quota($env{'form.ccdomain'},$oldinststatus,$name);
($newdefquota{$name},$newsettingstatus{$name}) = ($olddefquota{$name},$oldsettingstatus{$name});
}
my %canshow;
if (&Apache::lonnet::allowed('mpq',$env{'form.ccdomain'})) {
$canshow{'quota'} = 1;
}
if (&Apache::lonnet::allowed('mut',$env{'form.ccdomain'})) {
$canshow{'tools'} = 1;
}
if (&Apache::lonnet::allowed('ccc',$env{'form.ccdomain'})) {
$canshow{'requestcourses'} = 1;
} elsif (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'})) {
$canshow{'reqcrsotherdom'} = 1;
}
if (&Apache::lonnet::allowed('mau',$env{'form.ccdomain'})) {
$canshow{'inststatus'} = 1;
}
if (&Apache::lonnet::allowed('cau',$env{'form.ccdomain'})) {
$canshow{'requestauthor'} = 1;
}
my (%changeHash,%changed);
if ($oldinststatus eq '') {
$oldsettings{'inststatus'} = $othertitle;
} else {
if (ref($usertypes) eq 'HASH') {
$oldsettings{'inststatus'} = join(', ',map{ $usertypes->{ &unescape($_) }; } (split(/:/,$userenv{'inststatus'})));
} else {
$oldsettings{'inststatus'} = join(', ',map{ &unescape($_); } (split(/:/,$userenv{'inststatus'})));
}
}
$changeHash{'inststatus'} = $userenv{'inststatus'};
if ($canmodify_status{'inststatus'}) {
$canshow{'inststatus'} = 1;
if (exists($env{'form.inststatus'})) {
my @inststatuses = &Apache::loncommon::get_env_multiple('form.inststatus');
if (@inststatuses > 0) {
$newinststatus = join(':',map { &escape($_); } @inststatuses);
$changeHash{'inststatus'} = $newinststatus;
if ($newinststatus ne $oldinststatus) {
$changed{'inststatus'} = $newinststatus;
foreach my $name ('portfolio','author') {
($newdefquota{$name},$newsettingstatus{$name}) =
&Apache::loncommon::default_quota($env{'form.ccdomain'},$newinststatus,$name);
}
}
if (ref($usertypes) eq 'HASH') {
$newsettings{'inststatus'} = join(', ',map{ $usertypes->{$_}; } (@inststatuses));
} else {
$newsettings{'inststatus'} = join(', ',@inststatuses);
}
}
} else {
$newinststatus = '';
$changeHash{'inststatus'} = $newinststatus;
$newsettings{'inststatus'} = $othertitle;
if ($newinststatus ne $oldinststatus) {
$changed{'inststatus'} = $changeHash{'inststatus'};
foreach my $name ('portfolio','author') {
($newdefquota{$name},$newsettingstatus{$name}) =
&Apache::loncommon::default_quota($env{'form.ccdomain'},$newinststatus,$name);
}
}
}
} elsif ($context ne 'selfcreate') {
$canshow{'inststatus'} = 1;
$newsettings{'inststatus'} = $oldsettings{'inststatus'};
}
foreach my $name ('portfolio','author') {
$changeHash{$name.'quota'} = $userenv{$name.'quota'};
}
if ($context eq 'domain') {
foreach my $name ('portfolio','author') {
if ($userenv{$name.'quota'} ne '') {
$oldquota{$name} = $userenv{$name.'quota'};
if ($env{'form.custom_'.$name.'quota'} == 1) {
if ($env{'form.'.$name.'quota'} eq '') {
$newquota{$name} = 0;
} else {
$newquota{$name} = $env{'form.'.$name.'quota'};
$newquota{$name} =~ s/[^\d\.]//g;
}
if ($newquota{$name} != $oldquota{$name}) {
if ("a_admin($newquota{$name},\%changeHash,$name)) {
$changed{$name.'quota'} = 1;
}
}
} else {
if ("a_admin('',\%changeHash,$name)) {
$changed{$name.'quota'} = 1;
$newquota{$name} = $newdefquota{$name};
$newisdefault{$name} = 1;
}
}
} else {
$oldisdefault{$name} = 1;
$oldquota{$name} = $olddefquota{$name};
if ($env{'form.custom_'.$name.'quota'} == 1) {
if ($env{'form.'.$name.'quota'} eq '') {
$newquota{$name} = 0;
} else {
$newquota{$name} = $env{'form.'.$name.'quota'};
$newquota{$name} =~ s/[^\d\.]//g;
}
if ("a_admin($newquota{$name},\%changeHash,$name)) {
$changed{$name.'quota'} = 1;
}
} else {
$newquota{$name} = $newdefquota{$name};
$newisdefault{$name} = 1;
}
}
if ($oldisdefault{$name}) {
$oldsettingstext{'quota'}{$name} = &get_defaultquota_text($oldsettingstatus{$name});
} else {
$oldsettingstext{'quota'}{$name} = &mt('custom quota: [_1] MB',$oldquota{$name});
}
if ($newisdefault{$name}) {
$newsettingstext{'quota'}{$name} = &get_defaultquota_text($newsettingstatus{$name});
} else {
$newsettingstext{'quota'}{$name} = &mt('custom quota: [_1] MB',$newquota{$name});
}
}
&tool_changes('tools',\@usertools,\%oldsettings,\%oldsettingstext,\%userenv,
\%changeHash,\%changed,\%newsettings,\%newsettingstext);
if ($env{'form.ccdomain'} eq $env{'request.role.domain'}) {
&tool_changes('requestcourses',\@requestcourses,\%oldsettings,\%oldsettingstext,
\%userenv,\%changeHash,\%changed,\%newsettings,\%newsettingstext);
&tool_changes('requestauthor',\@requestauthor,\%oldsettings,\%oldsettingstext,
\%userenv,\%changeHash,\%changed,\%newsettings,\%newsettingstext);
} else {
&tool_changes('reqcrsotherdom',\@requestcourses,\%oldsettings,\%oldsettingstext,
\%userenv,\%changeHash,\%changed,\%newsettings,\%newsettingstext);
}
}
foreach my $item (@userinfo) {
if ($env{'form.c'.$item} ne $userenv{$item}) {
$namechanged{$item} = 1;
}
}
foreach my $name ('portfolio','author') {
$oldsettings{'quota'}{$name} = &mt('[_1] MB',$oldquota{$name});
$newsettings{'quota'}{$name} = &mt('[_1] MB',$newquota{$name});
}
if ((keys(%namechanged) > 0) || (keys(%changed) > 0)) {
my ($chgresult,$namechgresult);
if (keys(%changed) > 0) {
$chgresult =
&Apache::lonnet::put('environment',\%changeHash,
$env{'form.ccdomain'},$env{'form.ccuname'});
if ($chgresult eq 'ok') {
if (($env{'user.name'} eq $env{'form.ccuname'}) &&
($env{'user.domain'} eq $env{'form.ccdomain'})) {
my %newenvhash;
foreach my $key (keys(%changed)) {
if (($key eq 'official') || ($key eq 'unofficial')
|| ($key eq 'community') || ($key eq 'textbook')) {
$newenvhash{'environment.requestcourses.'.$key} =
$changeHash{'requestcourses.'.$key};
if ($changeHash{'requestcourses.'.$key}) {
$newenvhash{'environment.canrequest.'.$key} = 1;
} else {
$newenvhash{'environment.canrequest.'.$key} =
&Apache::lonnet::usertools_access($env{'user.name'},$env{'user.domain'},
$key,'reload','requestcourses');
}
} elsif ($key eq 'requestauthor') {
$newenvhash{'environment.'.$key} = $changeHash{$key};
if ($changeHash{$key}) {
$newenvhash{'environment.canrequest.author'} = 1;
} else {
$newenvhash{'environment.canrequest.author'} =
&Apache::lonnet::usertools_access($env{'user.name'},$env{'user.domain'},
$key,'reload','requestauthor');
}
} elsif ($key ne 'quota') {
$newenvhash{'environment.tools.'.$key} =
$changeHash{'tools.'.$key};
if ($changeHash{'tools.'.$key} ne '') {
$newenvhash{'environment.availabletools.'.$key} =
$changeHash{'tools.'.$key};
} else {
$newenvhash{'environment.availabletools.'.$key} =
&Apache::lonnet::usertools_access($env{'user.name'},$env{'user.domain'},
$key,'reload','tools');
}
}
}
if (keys(%newenvhash)) {
&Apache::lonnet::appenv(\%newenvhash);
}
}
}
}
if (keys(%namechanged) > 0) {
foreach my $field (@userinfo) {
$changeHash{$field} = $env{'form.c'.$field};
}
# Make the change
$namechgresult =
&Apache::lonnet::modifyuser($env{'form.ccdomain'},
$env{'form.ccuname'},$changeHash{'id'},undef,undef,
$changeHash{'firstname'},$changeHash{'middlename'},
$changeHash{'lastname'},$changeHash{'generation'},
$changeHash{'id'},undef,$changeHash{'permanentemail'},undef,\@userinfo);
%userupdate = (
lastname => $env{'form.clastname'},
middlename => $env{'form.cmiddlename'},
firstname => $env{'form.cfirstname'},
generation => $env{'form.cgeneration'},
id => $env{'form.cid'},
);
}
if (((keys(%namechanged) > 0) && $namechgresult eq 'ok') ||
((keys(%changed) > 0) && $chgresult eq 'ok')) {
# Tell the user we changed the name
&display_userinfo($r,1,\@disporder,\%canshow,\@requestcourses,
\@usertools,\@requestauthor,\%userenv,\%changed,\%namechanged,
\%oldsettings, \%oldsettingstext,\%newsettings,
\%newsettingstext);
if ($env{'form.cid'} ne $userenv{'id'}) {
&Apache::lonnet::idput($env{'form.ccdomain'},
{$env{'form.ccuname'} => $env{'form.cid'}});
if (($recurseid) &&
(&Apache::lonnet::allowed('mau',$env{'form.ccdomain'}))) {
my $idresult =
&Apache::lonuserutils::propagate_id_change(
$env{'form.ccuname'},$env{'form.ccdomain'},
\%userupdate);
$r->print('
'.$idresult.'
');
}
}
if (($env{'form.ccdomain'} eq $env{'user.domain'}) &&
($env{'form.ccuname'} eq $env{'user.name'})) {
my %newenvhash;
foreach my $key (keys(%changeHash)) {
$newenvhash{'environment.'.$key} = $changeHash{$key};
}
&Apache::lonnet::appenv(\%newenvhash);
}
} else { # error occurred
$r->print(
'');
my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles();
foreach my $field (@mod_disallowed) {
$r->print('
');
if (@mod_disallowed == 1) {
$r->print(&mt("You do not have the authority to change this field given the user's current set of active/future $contextname roles:"));
} else {
$r->print(&mt("You do not have the authority to change these fields given the user's current set of active/future $contextname roles:"));
}
my $helplink = 'javascript:helpMenu('."'display'".')';
$r->print(''.$rolestr.'
'
.&mt('Please contact your [_1]helpdesk[_2] for more information.'
,'','')
.'
');
}
$r->print(''
.$no_forceid_alert
.&Apache::lonuserutils::print_namespacing_alerts($env{'form.ccdomain'},\%alerts,\%curr_rules)
.'');
}
&Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
if ($env{'form.action'} eq 'singlestudent') {
&enroll_single_student($r,$uhome,$amode,$genpwd,$now,$newuser,$context,
$crstype,$showcredits,$defaultcredits);
my $linktext = ($crstype eq 'Community' ?
&mt('Enroll Another Member') : &mt('Enroll Another Student'));
$r->print(
&Apache::lonhtmlcommon::actionbox([
''
.($crstype eq 'Community' ?
&mt('Enroll Another Member') : &mt('Enroll Another Student'))
.'']));
} else {
my @rolechanges = &update_roles($r,$context,$showcredits);
if (keys(%namechanged) > 0) {
if ($context eq 'course') {
if (@userroles > 0) {
if ((@rolechanges == 0) ||
(!(grep(/^st$/,@rolechanges)))) {
if (grep(/^st$/,@userroles)) {
my $classlistupdated =
&Apache::lonuserutils::update_classlist($cdom,
$cnum,$env{'form.ccdomain'},
$env{'form.ccuname'},\%userupdate);
}
}
}
}
}
my $userinfo = &Apache::loncommon::plainname($env{'form.ccuname'},
$env{'form.ccdomain'});
if ($env{'form.popup'}) {
$r->print('');
} else {
$r->print('
'.&Apache::lonhtmlcommon::actionbox([''
.&mt('Modify this user: [_1]',''.$env{'form.ccuname'}.':'.$env{'form.ccdomain'}.' ('.$userinfo.')').'',
''.&mt('Create/Modify Another User').'']));
}
}
}
sub display_userinfo {
my ($r,$changed,$order,$canshow,$requestcourses,$usertools,$requestauthor,
$userenv,$changedhash,$namechangedhash,$oldsetting,$oldsettingtext,
$newsetting,$newsettingtext) = @_;
return unless (ref($order) eq 'ARRAY' &&
ref($canshow) eq 'HASH' &&
ref($requestcourses) eq 'ARRAY' &&
ref($requestauthor) eq 'ARRAY' &&
ref($usertools) eq 'ARRAY' &&
ref($userenv) eq 'HASH' &&
ref($changedhash) eq 'HASH' &&
ref($oldsetting) eq 'HASH' &&
ref($oldsettingtext) eq 'HASH' &&
ref($newsetting) eq 'HASH' &&
ref($newsettingtext) eq 'HASH');
my %lt=&Apache::lonlocal::texthash(
'ui' => 'User Information',
'uic' => 'User Information Changed',
'firstname' => 'First Name',
'middlename' => 'Middle Name',
'lastname' => 'Last Name',
'generation' => 'Generation',
'id' => 'Student/Employee ID',
'permanentemail' => 'Permanent e-mail address',
'portfolioquota' => 'Disk space allocated to portfolio files',
'authorquota' => 'Disk space allocated to Authoring Space',
'blog' => 'Blog Availability',
'webdav' => 'WebDAV Availability',
'aboutme' => 'Personal Information Page Availability',
'portfolio' => 'Portfolio Availability',
'official' => 'Can Request Official Courses',
'unofficial' => 'Can Request Unofficial Courses',
'community' => 'Can Request Communities',
'textbook' => 'Can Request Textbook Courses',
'requestauthor' => 'Can Request Author Role',
'inststatus' => "Affiliation",
'prvs' => 'Previous Value:',
'chto' => 'Changed To:'
);
if ($changed) {
$r->print(''.$lt{'uic'}.'
'.
&Apache::loncommon::start_data_table().
&Apache::loncommon::start_data_table_header_row());
$r->print(" \n");
$r->print(''.$lt{'prvs'}.' ');
$r->print(''.$lt{'chto'}.' ');
$r->print(&Apache::loncommon::end_data_table_header_row());
my @userinfo = ('firstname','middlename','lastname','generation','permanentemail','id');
foreach my $item (@userinfo) {
my $value = $env{'form.c'.$item};
#show changes only:
unless ($value eq $userenv->{$item}){
$r->print(&Apache::loncommon::start_data_table_row());
$r->print("$lt{$item} \n");
$r->print("".$userenv->{$item}." \n");
$r->print("$value \n");
$r->print(&Apache::loncommon::end_data_table_row());
}
}
foreach my $entry (@{$order}) {
if ($canshow->{$entry}) {
if (($entry eq 'requestcourses') || ($entry eq 'reqcrsotherdom') || ($entry eq 'requestauthor')) {
my @items;
if ($entry eq 'requestauthor') {
@items = ($entry);
} else {
@items = @{$requestcourses};
}
foreach my $item (@items) {
if (($newsetting->{$item} ne $oldsetting->{$item}) ||
($newsettingtext->{$item} ne $oldsettingtext->{$item})) {
$r->print(&Apache::loncommon::start_data_table_row()."\n");
$r->print("$lt{$item} \n");
$r->print("".$oldsetting->{$item});
if ($oldsettingtext->{$item}) {
if ($oldsetting->{$item}) {
$r->print(' -- ');
}
$r->print($oldsettingtext->{$item});
}
$r->print(" \n");
$r->print("".$newsetting->{$item});
if ($newsettingtext->{$item}) {
if ($newsetting->{$item}) {
$r->print(' -- ');
}
$r->print($newsettingtext->{$item});
}
$r->print(" \n");
$r->print(&Apache::loncommon::end_data_table_row()."\n");
}
}
} elsif ($entry eq 'tools') {
foreach my $item (@{$usertools}) {
if ($newsetting->{$item} ne $oldsetting->{$item}) {
$r->print(&Apache::loncommon::start_data_table_row()."\n");
$r->print("$lt{$item} \n");
$r->print("".$oldsetting->{$item}.' '.$oldsettingtext->{$item}." \n");
$r->print("".$newsetting->{$item}.' '.$newsettingtext->{$item}." \n");
$r->print(&Apache::loncommon::end_data_table_row()."\n");
}
}
} elsif ($entry eq 'quota') {
if ((ref($oldsetting->{$entry}) eq 'HASH') && (ref($oldsettingtext->{$entry}) eq 'HASH') &&
(ref($newsetting->{$entry}) eq 'HASH') && (ref($newsettingtext->{$entry}) eq 'HASH')) {
foreach my $name ('portfolio','author') {
if ($newsetting->{$entry}->{$name} ne $oldsetting->{$entry}->{$name}) {
$r->print(&Apache::loncommon::start_data_table_row()."\n");
$r->print("$lt{$name.$entry} \n");
$r->print("".$oldsettingtext->{$entry}->{$name}." \n");
$r->print("".$newsettingtext->{$entry}->{$name}." \n");
$r->print(&Apache::loncommon::end_data_table_row()."\n");
}
}
}
} else {
if ($newsetting->{$entry} ne $oldsetting->{$entry}) {
$r->print(&Apache::loncommon::start_data_table_row()."\n");
$r->print("$lt{$entry} \n");
$r->print("".$oldsetting->{$entry}.' '.$oldsettingtext->{$entry}." \n");
$r->print("".$newsetting->{$entry}.' '.$newsettingtext->{$entry}." \n");
$r->print(&Apache::loncommon::end_data_table_row()."\n");
}
}
}
}
$r->print(&Apache::loncommon::end_data_table().'
');
} else {
$r->print(''.$lt{'ui'}.'
'.
''.&mt('Modifying Roles').'
');
foreach my $key (keys(%env)) {
next if (! $env{$key});
next if ($key eq 'form.action');
# Revoke roles
if ($key=~/^form\.rev/) {
if ($key=~/^form\.rev\:([^\_]+)\_([^\_\.]+)$/) {
# Revoke standard role
my ($scope,$role) = ($1,$2);
my $result =
&Apache::lonnet::revokerole($env{'form.ccdomain'},
$env{'form.ccuname'},
$scope,$role,'','',$context);
$r->print(&Apache::lonhtmlcommon::confirm_success(
&mt('Revoking [_1] in [_2]',
&Apache::lonnet::plaintext($role),
&Apache::loncommon::show_role_extent($scope,$context,$role)),
$result ne "ok").'
');
if ($result ne "ok") {
$r->print(&mt('Error: [_1]',$result).'
');
}
if ($role eq 'st') {
my $result =
&Apache::lonuserutils::classlist_drop($scope,
$env{'form.ccuname'},$env{'form.ccdomain'},
$now);
$r->print(&Apache::lonhtmlcommon::confirm_success($result));
}
if (!grep(/^\Q$role\E$/,@rolechanges)) {
push(@rolechanges,$role);
}
}
if ($key=~m{^form\.rev\:([^_]+)_cr\.cr/($match_domain)/($match_username)/(\w+)$}s) {
# Revoke custom role
my $result = &Apache::lonnet::revokecustomrole(
$env{'form.ccdomain'},$env{'form.ccuname'},$1,$2,$3,$4,'','',$context);
$r->print(&Apache::lonhtmlcommon::confirm_success(
&mt('Revoking custom role [_1] by [_2] in [_3]',
$4,$3.':'.$2,&Apache::loncommon::show_role_extent($1,$context,'cr')),
$result ne 'ok').'
');
if ($result ne "ok") {
$r->print(&mt('Error: [_1]',$result).'
');
}
if (!grep(/^cr$/,@rolechanges)) {
push(@rolechanges,'cr');
}
}
} elsif ($key=~/^form\.del/) {
if ($key=~/^form\.del\:([^\_]+)\_([^\_\.]+)$/) {
# Delete standard role
my ($scope,$role) = ($1,$2);
my $result =
&Apache::lonnet::assignrole($env{'form.ccdomain'},
$env{'form.ccuname'},
$scope,$role,$now,0,1,'',
$context);
$r->print(&Apache::lonhtmlcommon::confirm_success(
&mt('Deleting [_1] in [_2]',
&Apache::lonnet::plaintext($role),
&Apache::loncommon::show_role_extent($scope,$context,$role)),
$result ne 'ok').'
');
if ($result ne "ok") {
$r->print(&mt('Error: [_1]',$result).'
');
}
if ($role eq 'st') {
my $result =
&Apache::lonuserutils::classlist_drop($scope,
$env{'form.ccuname'},$env{'form.ccdomain'},
$now);
$r->print(&Apache::lonhtmlcommon::confirm_success($result));
}
if (!grep(/^\Q$role\E$/,@rolechanges)) {
push(@rolechanges,$role);
}
}
if ($key=~m{^form\.del\:([^_]+)_cr\.cr/($match_domain)/($match_username)/(\w+)$}) {
my ($url,$rdom,$rnam,$rolename) = ($1,$2,$3,$4);
# Delete custom role
my $result =
&Apache::lonnet::assigncustomrole($env{'form.ccdomain'},
$env{'form.ccuname'},$url,$rdom,$rnam,$rolename,$now,
0,1,$context);
$r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Deleting custom role [_1] by [_2] in [_3]',
$rolename,$rnam.':'.$rdom,&Apache::loncommon::show_role_extent($1,$context,'cr')),
$result ne "ok").'
');
if ($result ne "ok") {
$r->print(&mt('Error: [_1]',$result).'
');
}
if (!grep(/^cr$/,@rolechanges)) {
push(@rolechanges,'cr');
}
}
} elsif ($key=~/^form\.ren/) {
my $udom = $env{'form.ccdomain'};
my $uname = $env{'form.ccuname'};
# Re-enable standard role
if ($key=~/^form\.ren\:([^\_]+)\_([^\_\.]+)$/) {
my $url = $1;
my $role = $2;
my $logmsg;
my $output;
if ($role eq 'st') {
if ($url =~ m-^/($match_domain)/($match_courseid)/?(\w*)$-) {
my ($cdom,$cnum,$csec) = ($1,$2,$3);
my $credits;
if ($showcredits) {
my $defaultcredits =
&Apache::lonuserutils::get_defaultcredits($cdom,$cnum);
$credits = &get_user_credits($defaultcredits,$cdom,$cnum);
}
my $result = &Apache::loncommon::commit_studentrole(\$logmsg,$udom,$uname,$url,$role,$now,0,$cdom,$cnum,$csec,$context,$credits);
if (($result =~ /^error/) || ($result eq 'not_in_class') || ($result eq 'unknown_course') || ($result eq 'refused')) {
if ($result eq 'refused' && $logmsg) {
$output = $logmsg;
} else {
$output = &mt('Error: [_1]',$result)."\n";
}
} else {
$output = &Apache::lonhtmlcommon::confirm_success(&mt('Assigning [_1] in [_2] starting [_3]',
&Apache::lonnet::plaintext($role),
&Apache::loncommon::show_role_extent($url,$context,'st'),
&Apache::lonlocal::locallocaltime($now))).'
'.$logmsg.'
';
}
}
} else {
my $result=&Apache::lonnet::assignrole($env{'form.ccdomain'},
$env{'form.ccuname'},$url,$role,0,$now,'','',
$context);
$output = &Apache::lonhtmlcommon::confirm_success(&mt('Re-enabling [_1] in [_2]',
&Apache::lonnet::plaintext($role),
&Apache::loncommon::show_role_extent($url,$context,$role)),$result ne "ok").'
';
if ($result ne "ok") {
$output .= &mt('Error: [_1]',$result).'
';
}
}
$r->print($output);
if (!grep(/^\Q$role\E$/,@rolechanges)) {
push(@rolechanges,$role);
}
}
# Re-enable custom role
if ($key=~m{^form\.ren\:([^_]+)_cr\.cr/($match_domain)/($match_username)/(\w+)$}) {
my ($url,$rdom,$rnam,$rolename) = ($1,$2,$3,$4);
my $result = &Apache::lonnet::assigncustomrole(
$env{'form.ccdomain'}, $env{'form.ccuname'},
$url,$rdom,$rnam,$rolename,0,$now,undef,$context);
$r->print(&Apache::lonhtmlcommon::confirm_success(
&mt('Re-enabling custom role [_1] by [_2] in [_3]',
$rolename,$rnam.':'.$rdom,&Apache::loncommon::show_role_extent($1,$context,'cr')),
$result ne "ok").'
');
if ($result ne "ok") {
$r->print(&mt('Error: [_1]',$result).'
');
}
if (!grep(/^cr$/,@rolechanges)) {
push(@rolechanges,'cr');
}
}
} elsif ($key=~/^form\.act/) {
my $udom = $env{'form.ccdomain'};
my $uname = $env{'form.ccuname'};
if ($key=~/^form\.act\_($match_domain)\_($match_courseid)\_cr_cr_($match_domain)_($match_username)_([^\_]+)$/) {
# Activate a custom role
my ($one,$two,$three,$four,$five)=($1,$2,$3,$4,$5);
my $url='/'.$one.'/'.$two;
my $full=$one.'_'.$two.'_cr_cr_'.$three.'_'.$four.'_'.$five;
my $start = ( $env{'form.start_'.$full} ?
$env{'form.start_'.$full} :
$now );
my $end = ( $env{'form.end_'.$full} ?
$env{'form.end_'.$full} :
0 );
# split multiple sections
my %sections = ();
my $num_sections = &build_roles($env{'form.sec_'.$full},\%sections,$5);
if ($num_sections == 0) {
$r->print(&Apache::loncommon::commit_customrole($udom,$uname,$url,$three,$four,$five,$start,$end,$context));
} else {
my %curr_groups =
&Apache::longroup::coursegroups($one,$two);
foreach my $sec (sort {$a cmp $b} keys(%sections)) {
if (($sec eq 'none') || ($sec eq 'all') ||
exists($curr_groups{$sec})) {
$disallowed{$sec} = $url;
next;
}
my $securl = $url.'/'.$sec;
$r->print(&Apache::loncommon::commit_customrole($udom,$uname,$securl,$three,$four,$five,$start,$end,$context));
}
}
if (!grep(/^cr$/,@rolechanges)) {
push(@rolechanges,'cr');
}
} elsif ($key=~/^form\.act\_($match_domain)\_($match_name)\_([^\_]+)$/) {
# Activate roles for sections with 3 id numbers
# set start, end times, and the url for the class
my ($one,$two,$three)=($1,$2,$3);
my $start = ( $env{'form.start_'.$one.'_'.$two.'_'.$three} ?
$env{'form.start_'.$one.'_'.$two.'_'.$three} :
$now );
my $end = ( $env{'form.end_'.$one.'_'.$two.'_'.$three} ?
$env{'form.end_'.$one.'_'.$two.'_'.$three} :
0 );
my $url='/'.$one.'/'.$two;
my $type = 'three';
# split multiple sections
my %sections = ();
my $num_sections = &build_roles($env{'form.sec_'.$one.'_'.$two.'_'.$three},\%sections,$three);
my $credits;
if ($three eq 'st') {
if ($showcredits) {
my $defaultcredits =
&Apache::lonuserutils::get_defaultcredits($one,$two);
$credits = $env{'form.credits_'.$one.'_'.$two.'_'.$three};
$credits =~ s/[^\d\.]//g;
if ($credits eq $defaultcredits) {
undef($credits);
}
}
}
if ($num_sections == 0) {
$r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$url,$three,$start,$end,$one,$two,'',$context,$credits));
} else {
my %curr_groups =
&Apache::longroup::coursegroups($one,$two);
my $emptysec = 0;
foreach my $sec (sort {$a cmp $b} keys(%sections)) {
$sec =~ s/\W//g;
if ($sec ne '') {
if (($sec eq 'none') || ($sec eq 'all') ||
exists($curr_groups{$sec})) {
$disallowed{$sec} = $url;
next;
}
my $securl = $url.'/'.$sec;
$r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$securl,$three,$start,$end,$one,$two,$sec,$context,$credits));
} else {
$emptysec = 1;
}
}
if ($emptysec) {
$r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$url,$three,$start,$end,$one,$two,'',$context,$credits));
}
}
if (!grep(/^\Q$three\E$/,@rolechanges)) {
push(@rolechanges,$three);
}
} elsif ($key=~/^form\.act\_([^\_]+)\_([^\_]+)$/) {
# Activate roles for sections with two id numbers
# set start, end times, and the url for the class
my $start = ( $env{'form.start_'.$1.'_'.$2} ?
$env{'form.start_'.$1.'_'.$2} :
$now );
my $end = ( $env{'form.end_'.$1.'_'.$2} ?
$env{'form.end_'.$1.'_'.$2} :
0 );
my $one = $1;
my $two = $2;
my $url='/'.$one.'/';
# split multiple sections
my %sections = ();
my $num_sections = &build_roles($env{'form.sec_'.$one.'_'.$two},\%sections,$two);
if ($num_sections == 0) {
$r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$url,$two,$start,$end,$one,undef,'',$context));
} else {
my $emptysec = 0;
foreach my $sec (sort {$a cmp $b} keys(%sections)) {
if ($sec ne '') {
my $securl = $url.'/'.$sec;
$r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$securl,$two,$start,$end,$one,undef,$sec,$context));
} else {
$emptysec = 1;
}
}
if ($emptysec) {
$r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$url,$two,$start,$end,$one,undef,'',$context));
}
}
if (!grep(/^\Q$two\E$/,@rolechanges)) {
push(@rolechanges,$two);
}
} else {
$r->print('
');
}
foreach my $key (sort(keys(%disallowed))) {
$r->print('';
# ------------------------------------------------------- Does this role exist?
my ($rdummy,$roledef)=
&Apache::lonnet::get('roles',["rolesdef_$rolename"]);
if (($rdummy ne 'con_lost') && ($roledef ne '')) {
$body_top .= &mt('Existing Role').' "';
# ------------------------------------------------- Get current role privileges
($privs{'system'},$privs{'domain'},$privs{'course'})=split(/\_/,$roledef);
if ($privs{'system'} =~ /bre\&S/) {
if ($context eq 'domain') {
$crstype = 'Course';
} elsif ($crstype eq 'Community') {
$privs{'system'} =~ s/bre\&S//;
}
} elsif ($context eq 'domain') {
$crstype = 'Course';
}
} else {
$body_top .= &mt('New Role').' "';
$roledef='';
}
$body_top .= $rolename.'"
';
# ------------------------------------------------------- What can be assigned?
my %full=();
my %levels=(
course => {},
domain => {},
system => {},
);
my %levelscurrent=(
course => {},
domain => {},
system => {},
);
&Apache::lonuserutils::custom_role_privs(\%privs,\%full,\%levels,\%levelscurrent);
my ($jsback,$elements) = &crumb_utilities();
my @templateroles = &Apache::lonuserutils::custom_template_roles($context,$crstype);
my $head_script =
&Apache::lonuserutils::custom_roledefs_js($context,$crstype,$formname,
\%full,\@templateroles,$jsback);
push (@{$brcrum},
{href => "javascript:backPage(document.$formname,'pickrole','')",
text => "Pick custom role",
faq => 282,bug=>'Instructor Interface',},
{href => "javascript:backPage(document.$formname,'','')",
text => "Edit custom role",
faq => 282,
bug => 'Instructor Interface',
help => 'Course_Editing_Custom_Roles'}
);
my $args = { bread_crumbs => $brcrum,
bread_crumbs_component => 'User Management'};
$r->print(&Apache::loncommon::start_page('Custom Role Editor',
$head_script,$args).
$body_top);
$r->print('');
}
# ---------------------------------------------------------- Call to definerole
sub set_custom_role {
my ($r,$context,$brcrum,$prefix) = @_;
my $rolename=$env{'form.rolename'};
$rolename=~s/[^A-Za-z0-9]//gs;
if (!$rolename) {
&custom_role_editor($r,$brcrum,$prefix);
return;
}
my ($jsback,$elements) = &crumb_utilities();
my $jscript = ''."\n";
push(@{$brcrum},
{href => "javascript:backPage(document.customresult,'pickrole','')",
text => "Pick custom role",
faq => 282,
bug => 'Instructor Interface',},
{href => "javascript:backPage(document.customresult,'selected_custom_edit','')",
text => "Edit custom role",
faq => 282,
bug => 'Instructor Interface',},
{href => "javascript:backPage(document.customresult,'set_custom_roles','')",
text => "Result",
faq => 282,
bug => 'Instructor Interface',
help => 'Course_Editing_Custom_Roles'},
);
my $args = { bread_crumbs => $brcrum,
bread_crumbs_component => 'User Management'};
$r->print(&Apache::loncommon::start_page('Save Custom Role',$jscript,$args));
my $newrole;
my ($rdummy,$roledef)=
&Apache::lonnet::get('roles',["rolesdef_$rolename"]);
# ------------------------------------------------------- Does this role exist?
$r->print('');
if (($rdummy ne 'con_lost') && ($roledef ne '')) {
$r->print(&mt('Existing Role').' "');
} else {
$r->print(&mt('New Role').' "');
$roledef='';
$newrole = 1;
}
$r->print($rolename.'"
');
# ------------------------------------------------- Assign role and show result
my $errmsg;
my %newprivs = &Apache::lonuserutils::custom_role_update($rolename,$prefix);
# Assign role and return result
my $result = &Apache::lonnet::definerole($rolename,$newprivs{'s'},$newprivs{'d'},
$newprivs{'c'});
if ($result ne 'ok') {
$errmsg = ': '.$result;
}
my $message =
&Apache::lonhtmlcommon::confirm_success(
&mt('Defining Role').$errmsg, ($result eq 'ok' ? 0 : 1));
if ($env{'request.course.id'}) {
my $url='/'.$env{'request.course.id'};
$url=~s/\_/\//g;
$result =
&Apache::lonnet::assigncustomrole(
$env{'user.domain'},$env{'user.name'},
$url,
$env{'user.domain'},$env{'user.name'},
$rolename,undef,undef,undef,$context);
if ($result ne 'ok') {
$errmsg = ': '.$result;
}
$message .=
'
'
.&Apache::lonhtmlcommon::confirm_success(
&mt('Assigning Role to Self').$errmsg, ($result eq 'ok' ? 0 : 1));
}
$r->print(
&Apache::loncommon::confirmwrapper($message)
.'
'
.&Apache::lonhtmlcommon::actionbox([
''
.&mt('Create or edit another custom role')
.''])
.''
);
}
# ================================================================ Main Handler
sub handler {
my $r = shift;
if ($r->header_only) {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
return OK;
}
my ($context,$crstype);
if ($env{'request.course.id'}) {
$context = 'course';
$crstype = &Apache::loncommon::course_type();
} elsif ($env{'request.role'} =~ /^au\./) {
$context = 'author';
} else {
$context = 'domain';
}
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
['action','state','callingform','roletype','showrole','bulkaction','popup','phase',
'username','domain','srchterm','srchdomain','srchin','srchby','srchtype','queue']);
&Apache::lonhtmlcommon::clear_breadcrumbs();
my $args;
my $brcrum = [];
my $bread_crumbs_component = 'User Management';
if (($env{'form.action'} ne 'dateselect') && ($env{'form.action'} ne 'displayuserreq')) {
$brcrum = [{href=>"/adm/createuser",
text=>"User Management",
help=>'Course_Create_Class_List,Course_Change_Privileges,Course_View_Class_List,Course_Editing_Custom_Roles,Course_Add_Student,Course_Drop_Student,Course_Automated_Enrollment,Course_Self_Enrollment,Course_Manage_Group'}
];
}
#SD Following files not added to help, because the corresponding .tex-files seem to
#be missing: Course_Approve_Selfenroll,Course_User_Logs,
my ($permission,$allowed) =
&Apache::lonuserutils::get_permission($context,$crstype);
if (!$allowed) {
if ($context eq 'course') {
$r->internal_redirect('/adm/viewclasslist');
return OK;
}
$env{'user.error.msg'}=
"/adm/createuser:cst:0:0:Cannot create/modify user data ".
"or view user status.";
return HTTP_NOT_ACCEPTABLE;
}
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $showcredits;
if ((($context eq 'course') && ($crstype eq 'Course')) ||
($context eq 'domain')) {
my %domdefaults =
&Apache::lonnet::get_domain_defaults($env{'request.role.domain'});
if ($domdefaults{'officialcredits'} || $domdefaults{'unofficialcredits'}) {
$showcredits = 1;
}
}
# Main switch on form.action and form.state, as appropriate
if (! exists($env{'form.action'})) {
$args = {bread_crumbs => $brcrum,
bread_crumbs_component => $bread_crumbs_component};
$r->print(&header(undef,$args));
$r->print(&print_main_menu($permission,$context,$crstype));
} elsif ($env{'form.action'} eq 'upload' && $permission->{'cusr'}) {
push(@{$brcrum},
{ href => '/adm/createuser?action=upload&state=',
text => 'Upload Users List',
help => 'Course_Create_Class_List',
});
$bread_crumbs_component = 'Upload Users List';
$args = {bread_crumbs => $brcrum,
bread_crumbs_component => $bread_crumbs_component};
$r->print(&header(undef,$args));
$r->print('
'.$visactions->{'vis'}.'
'; } else { $output .= ''.$visactions->{'miss'}.'
' .$visactions->{'yous'}. ''.$visactions->{'gen'}.'
'.$visactions->{'coca'};
if (ref($vismsgs) eq 'ARRAY') {
$output .= '
'.$visactions->{'make'}.'
'.&mt('Existing sections')."\n".
' '.$sections_select.' | '.
&mt('New section').' '."\n". ''."\n". ''."\n". ' |
'. (' 'x3).&mt('Maximum number allowed: '). ' |
'; } $count ++; } if (($count > 0) && ($count%$numinrow == 0)) { $output .= ' |
' .&mt('There are no records to display.') .'
' ); } # Form Footer $r->print( '' .'' .'' .&mt('You do not have rights to display user access logs.') .'
' .&earlyout_accesslog_form($formname,$prevphasestr,$udom)); return; } unless ($udom eq $env{'request.role.domain'}) { $r->print('' .&mt("User's domain must match role's domain") .'
' .&earlyout_accesslog_form($formname,$prevphasestr,$udom)); return; } if (($uname eq '') || ($udom eq '')) { $r->print('' .&mt('Invalid username or domain') .'
' .&earlyout_accesslog_form($formname,$prevphasestr,$udom)); return; } # set defaults my $now = time(); my $defstart = $now - (7*24*3600); my %defaults = ( page => '1', show => '10', activity => 'any', accesslog_start_date => $defstart, accesslog_end_date => $now, ); my $more_records = 0; # set current my %curr; foreach my $item ('show','page','activity') { $curr{$item} = $env{'form.'.$item}; } my ($startdate,$enddate) = &Apache::lonuserutils::get_dates_from_form('accesslog_start_date','accesslog_end_date'); $curr{'accesslog_start_date'} = $startdate; $curr{'accesslog_end_date'} = $enddate; foreach my $key (keys(%defaults)) { if ($curr{$key} eq '') { $curr{$key} = $defaults{$key}; } } my ($minshown,$maxshown); $minshown = 1; my $count = 0; if ($curr{'show'} =~ /\D/) { $curr{'page'} = 1; } else { $maxshown = $curr{'page'} * $curr{'show'}; if ($curr{'page'} > 1) { $minshown = 1 + ($curr{'page'} - 1) * $curr{'show'}; } } # form header $r->print('' .&mt('There are no records to display.') .'
'); } if ($env{'form.popup'} == 1) { $r->print(''."\n"); } # Form Footer $r->print( '' .'' .'' .'' .'' .'' .'' .'' .'' .'' .'' .'' .''.
''.&mt('Actions/page:').' '. &Apache::lonmeta::selectbox('show',$curr->{'show'},undef, (&mt('all'),5,10,20,50,100,1000,10000)). ' | '; my $startform = &Apache::lonhtmlcommon::date_setter($formname,'accesslog_start_date', $curr->{'accesslog_start_date'},undef, undef,undef,undef,undef,undef,undef,$nolink); my $endform = &Apache::lonhtmlcommon::date_setter($formname,'accesslog_end_date', $curr->{'accesslog_end_date'},undef, undef,undef,undef,undef,undef,undef,$nolink); my %lt = &Apache::lonlocal::texthash ( activity => 'Activity', Role => 'Role selection', log => 'Log-in or Logout', ); $output .= ' | '.&mt('Window during which actions occurred:').' '. '
| '.
''. ' | '.&mt('Activities').' '. ' | '.
'
' .'' .'
'; return $output; } sub userlogdisplay_js { my ($formname) = @_; return <<"ENDSCRIPT"; function chgPage(caller) { if (caller == 'previous') { document.$formname.page.value --; } if (caller == 'next') { document.$formname.page.value ++; } document.$formname.submit(); return; } ENDSCRIPT } sub userlogdisplay_navlinks { my ($curr,$more_records) = @_; return unless(ref($curr) eq 'HASH'); # Navigation Buttons my $nav_links = ''; if (($curr->{'page'} > 1) || ($more_records)) { if (($curr->{'page'} > 1) && ($curr->{'show'} !~ /\D/)) { $nav_links .= ' '; } if ($more_records) { $nav_links .= ''; } } $nav_links .= '
'; return $nav_links; } sub role_display_filter { my ($context,$formname,$cdom,$cnum,$curr,$version,$crstype) = @_; my $lctype; if ($context eq 'course') { $lctype = lc($crstype); } my $nolink = 1; my $output = ''.
''.&mt('Changes/page:').' '. &Apache::lonmeta::selectbox('show',$curr->{'show'},undef, (&mt('all'),5,10,20,50,100,1000,10000)). ' | '; my $startform = &Apache::lonhtmlcommon::date_setter($formname,'rolelog_start_date', $curr->{'rolelog_start_date'},undef, undef,undef,undef,undef,undef,undef,$nolink); my $endform = &Apache::lonhtmlcommon::date_setter($formname,'rolelog_end_date', $curr->{'rolelog_end_date'},undef, undef,undef,undef,undef,undef,undef,$nolink); my %lt = &rolechg_contexts($context,$crstype); $output .= ' | '.&mt('Window during which changes occurred:').' '. '
| '.
''. ' | '.&mt('Role:').' '. ' | '.
''. ' | '.
&mt('Context:').' | '
.'
' .'' .'
'; # Server version info my $needsrev = '2.11.0'; if ($context eq 'course') { $needsrev = '2.7.0'; } $output .= '' .&mt('Only changes made from servers running LON-CAPA [_1] or later are displayed.' ,$needsrev); if ($version) { $output .= ' '.&mt('This LON-CAPA server is version [_1]',$version); } $output .= '
'.$lt{'tfh'}.': '.join(', ',map { $description{$_}; } @roles_by_num).'.');
if ($permission->{'owner'}) {
$r->print('
'.$lt{'aco'}.'
');
$r->print(''.
'');
} else {
if ($env{'course.'.$env{'request.course.id'}.'.internal.courseowner'}) {
my ($ownername,$ownerdom) = split(/:/,$env{'course.'.$env{'request.course.id'}.'.internal.courseowner'});
$r->print('
'.&mt('The course owner -- [_1] -- can override the default access and/or privileges for these ad hoc roles.',
&Apache::loncommon::aboutmewrapper(&Apache::loncommon::plainname($ownername,$ownerdom),$ownername,$ownerdom)));
}
$disabled = ' disabled="disabled"';
}
$r->print('
'.&mt('You do not have permission to change helpdesk access.').'
'); return; } my @accesstypes = ('all','none','status','inc','exc'); my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; my $confname = $cdom.'-domainconfig'; my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($cdom); my $crstype = &Apache::loncommon::course_type(); my %customroles = &get_domain_customroles($cdom,$confname); my (%settings,%overridden); &get_adhocrole_settings($env{'request.course.id'},\@accesstypes, $types,\%customroles,\%settings,\%overridden); my %domhelpdesk = &Apache::lonnet::get_active_domroles($cdom,['dh']); my (%changed,%storehash,@todelete); if (keys(%customroles)) { my (%newsettings,@incrs); foreach my $role (keys(%customroles)) { $newsettings{$role} = { access => '', status => '', exc => '', inc => '', on => '', off => '', }; my %current; if (ref($settings{$role}) eq 'HASH') { %current = %{$settings{$role}}; } if (ref($overridden{$role}) eq 'HASH') { $current{'overridden'} = $overridden{$role}; } if ($env{'form.'.$role.'_incrs'}) { my $access = $env{'form.'.$role.'_access'}; if (grep(/^\Q$access\E$/,@accesstypes)) { push(@incrs,$role); unless ($current{'access'} eq $access) { $changed{$role}{'access'} = 1; $storehash{'internal.adhoc.'.$role} = $access; } if ($access eq 'status') { my @statuses = &Apache::loncommon::get_env_multiple('form.'.$role.'_status'); my @stored; my @shownstatus; if (ref($types) eq 'ARRAY') { foreach my $type (sort(@statuses)) { if ($type eq 'default') { push(@stored,$type); } elsif (grep(/^\Q$type\E$/,@{$types})) { push(@stored,$type); push(@shownstatus,$usertypes->{$type}); } } if (grep(/^default$/,@statuses)) { push(@shownstatus,$othertitle); } $storehash{'internal.adhoc.'.$role} .= '='.join(',',@stored); } $newsettings{$role}{'status'} = join(' '.&mt('or').' ',@shownstatus); if (ref($current{'status'}) eq 'ARRAY') { my @diffs = &Apache::loncommon::compare_arrays(\@stored,$current{'status'}); if (@diffs) { $changed{$role}{'status'} = 1; } } elsif (@stored) { $changed{$role}{'status'} = 1; } } elsif (($access eq 'inc') || ($access eq 'exc')) { my @personnel = &Apache::loncommon::get_env_multiple('form.'.$role.'_staff_'.$access); my @newspecstaff; my @stored; my @currstaff; foreach my $person (sort(@personnel)) { if ($domhelpdesk{$person}) { push(@stored,$person); } } if (ref($current{$access}) eq 'ARRAY') { my @diffs = &Apache::loncommon::compare_arrays(\@stored,$current{$access}); if (@diffs) { $changed{$role}{$access} = 1; } } elsif (@stored) { $changed{$role}{$access} = 1; } $storehash{'internal.adhoc.'.$role} .= '='.join(',',@stored); foreach my $person (@stored) { my ($uname,$udom) = split(/:/,$person); push(@newspecstaff,&Apache::loncommon::aboutmewrapper(&Apache::loncommon::plainname($uname,$udom,'lastname'),$uname,$udom)); } $newsettings{$role}{$access} = join(', ',sort(@newspecstaff)); } $newsettings{$role}{'access'} = $access; } } else { if (($current{'access'} ne '') && (grep(/^\Q$current{'access'}\E$/,@accesstypes))) { $changed{$role}{'access'} = 1; $newsettings{$role} = {}; push(@todelete,'internal.adhoc.'.$role); } } if (($env{'form.'.$role.'_incrs'}) && ($env{'form.'.$role.'_access'} eq 'none')) { if (ref($current{'overridden'}) eq 'HASH') { push(@todelete,'internal.adhocpriv.'.$role); } } else { my %full=(); my %levels= ( course => {}, domain => {}, system => {}, ); my %levelscurrent=( course => {}, domain => {}, system => {}, ); &Apache::lonuserutils::custom_role_privs($customroles{$role},\%full,\%levels,\%levelscurrent); my (@updatedon,@updatedoff,@override); @override = &Apache::loncommon::get_env_multiple('form.'.$role.'_override'); if (@override) { foreach my $priv (sort(keys(%full))) { next unless ($levels{'course'}{$priv}); if (grep(/^\Q$priv\E$/,@override)) { if ($levelscurrent{'course'}{$priv}) { push(@updatedoff,$priv); } else { push(@updatedon,$priv); } } } } if (@updatedon) { $newsettings{$role}{'on'} = join(''.$lt->{'exs'}.' '. $currsec.' | '."\n".
' '."\n". ' | '.$lt->{'new'}.' '. ''. ' | '."\n".
'
'.$lt{'exs'}.' | '.
''. ' | '.$lt{'new'}.' '. ''. ''. ''. ' | '.
'