# The LearningOnline Network with CAPA
# Utility functions for managing LON-CAPA user accounts
#
# $Id: lonuserutils.pm,v 1.28 2007/12/22 19:12:51 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::lonuserutils;
use strict;
use Apache::lonnet;
use Apache::loncommon();
use Apache::lonhtmlcommon;
use Apache::lonlocal;
use Apache::longroup;
use LONCAPA qw(:DEFAULT :match);
###############################################################
###############################################################
# Drop student from all sections of a course, except optional $csec
sub modifystudent {
my ($udom,$unam,$courseid,$csec,$desiredhost)=@_;
# if $csec is undefined, drop the student from all the courses matching
# this one. If $csec is defined, drop them from all other sections of
# this course and add them to section $csec
my ($cnum,$cdom) = &get_course_identity($courseid);
my %roles = &Apache::lonnet::dump('roles',$udom,$unam);
my ($tmp) = keys(%roles);
# Bail out if we were unable to get the students roles
return "$1" if ($tmp =~ /^(con_lost|error|no_such_host)/i);
# Go through the roles looking for enrollment in this course
my $result = '';
foreach my $course (keys(%roles)) {
if ($course=~m{^/\Q$cdom\E/\Q$cnum\E(?:\/)*(?:\s+)*(\w+)*\_st$}) {
# We are in this course
my $section=$1;
$section='' if ($course eq "/$cdom/$cnum".'_st');
if (defined($csec) && $section eq $csec) {
$result .= 'ok:';
} elsif ( ((!$section) && (!$csec)) || ($section ne $csec) ) {
my (undef,$end,$start)=split(/\_/,$roles{$course});
my $now=time;
# if this is an active role
if (!($start && ($now<$start)) || !($end && ($now>$end))) {
my $reply=&Apache::lonnet::modifystudent
# dom name id mode pass f m l g
($udom,$unam,'', '', '',undef,undef,undef,undef,
$section,time,undef,undef,$desiredhost,'','manual',
'',$courseid);
$result .= $reply.':';
}
}
}
}
if ($result eq '') {
$result = 'Unable to find section for this student';
} else {
$result =~ s/(ok:)+/ok/g;
}
return $result;
}
sub modifyuserrole {
my ($context,$setting,$changeauth,$cid,$udom,$uname,$uid,$umode,$upass,
$first,$middle,$last,$gene,$sec,$forceid,$desiredhome,$email,$role,
$end,$start,$checkid) = @_;
my ($scope,$userresult,$authresult,$roleresult,$idresult);
if ($setting eq 'course' || $context eq 'course') {
$scope = '/'.$cid;
$scope =~ s/\_/\//g;
if ($role ne 'cc' && $sec ne '') {
$scope .='/'.$sec;
}
} elsif ($context eq 'domain') {
$scope = '/'.$env{'request.role.domain'}.'/';
} elsif ($context eq 'author') {
$scope = '/'.$env{'user.domain'}.'/'.$env{'user.name'};
}
if ($context eq 'domain') {
my $uhome = &Apache::lonnet::homeserver($uname,$udom);
if ($uhome ne 'no_host') {
if (($changeauth eq 'Yes') && (&Apache::lonnet::allowed('mau',$udom))) {
if ((($umode =~ /^krb4|krb5|internal$/) && $upass ne '') ||
($umode eq 'localauth')) {
$authresult = &Apache::lonnet::modifyuserauth($udom,$uname,$umode,$upass);
}
}
if (($forceid) && (&Apache::lonnet::allowed('mau',$udom)) &&
($env{'form.recurseid'}) && ($checkid)) {
my %userupdate = (
lastname => $last,
middlename => $middle,
firstname => $first,
generation => $gene,
id => $uid,
);
$idresult = &propagate_id_change($uname,$udom,\%userupdate);
}
}
}
$userresult =
&Apache::lonnet::modifyuser($udom,$uname,$uid,$umode,$upass,$first,
$middle,$last,$gene,$forceid,$desiredhome,
$email,$role,$start,$end);
if ($userresult eq 'ok') {
if ($role ne '') {
$role =~ s/_/\//g;
$roleresult = &Apache::lonnet::assignrole($udom,$uname,$scope,
$role,$end,$start);
}
}
return ($userresult,$authresult,$roleresult,$idresult);
}
sub propagate_id_change {
my ($uname,$udom,$user) = @_;
my (@types,@roles);
@types = ('active','future');
@roles = ('st');
my $idresult;
my %roleshash = &Apache::lonnet::get_my_roles($uname,
$udom,'userroles',\@types,\@roles);
my %args = (
one_time => 1,
);
foreach my $item (keys(%roleshash)) {
my ($cnum,$cdom,$role) = split(/:/,$item,-1);
my ($start,$end) = split(/:/,$roleshash{$item});
if (&Apache::lonnet::is_course($cdom,$cnum)) {
my $result = &update_classlist($cdom,$cnum,$udom,$uname,$user);
my %coursehash =
&Apache::lonnet::coursedescription($cdom.'_'.$cnum,\%args);
my $cdesc = $coursehash{'description'};
if ($cdesc eq '') {
$cdesc = $cdom.'_'.$cnum;
}
if ($result eq 'ok') {
$idresult .= &mt('Classlist update for "[_1]" in "[_2]".',$uname.':'.$udom,$cdesc).'
'."\n";
} else {
$idresult .= &mt('Error: "[_1]" during classlist update for "[_2]" in "[_3]".',$result,$uname.':'.$udom,$cdesc).'
'."\n";
}
}
}
return $idresult;
}
sub update_classlist {
my ($cdom,$cnum,$udom,$uname,$user) = @_;
my ($uid,$classlistentry);
my $fullname =
&Apache::lonnet::format_name($user->{'firstname'},$user->{'middlename'},
$user->{'lastname'},$user->{'generation'},
'lastname');
my %classhash = &Apache::lonnet::get('classlist',[$uname.':'.$udom],
$cdom,$cnum);
my @classinfo = split(/:/,$classhash{$uname.':'.$udom});
my $ididx=&Apache::loncoursedata::CL_ID() - 2;
my $nameidx=&Apache::loncoursedata::CL_FULLNAME() - 2;
for (my $i=0; $i<@classinfo; $i++) {
if ($i == $ididx) {
if (defined($user->{'id'})) {
$classlistentry .= $user->{'id'}.':';
} else {
$classlistentry .= $classinfo[$i].':';
}
} elsif ($i == $nameidx) {
$classlistentry .= $fullname.':';
} else {
$classlistentry .= $classinfo[$i].':';
}
}
$classlistentry =~ s/:$//;
my $reply=&Apache::lonnet::cput('classlist',
{"$uname:$udom" => $classlistentry},
$cdom,$cnum);
if (($reply eq 'ok') || ($reply eq 'delayed')) {
return 'ok';
} else {
return 'error: '.$reply;
}
}
###############################################################
###############################################################
# build a role type and role selection form
sub domain_roles_select {
# Set up the role type and role selection boxes when in
# domain context
#
# Role types
my @roletypes = ('domain','author','course');
my %lt = &role_type_names();
#
# build up the menu information to be passed to
# &Apache::loncommon::linked_select_forms
my %select_menus;
if ($env{'form.roletype'} eq '') {
$env{'form.roletype'} = 'domain';
}
foreach my $roletype (@roletypes) {
# set up the text for this domain
$select_menus{$roletype}->{'text'}= $lt{$roletype};
# we want a choice of 'default' as the default in the second menu
if ($env{'form.roletype'} ne '') {
$select_menus{$roletype}->{'default'} = $env{'form.showrole'};
} else {
$select_menus{$roletype}->{'default'} = 'Any';
}
# Now build up the other items in the second menu
my @roles;
if ($roletype eq 'domain') {
@roles = &domain_roles();
} elsif ($roletype eq 'author') {
@roles = &construction_space_roles();
} else {
my $custom = 1;
@roles = &course_roles('domain',undef,$custom);
}
my $order = ['Any',@roles];
$select_menus{$roletype}->{'order'} = $order;
foreach my $role (@roles) {
if ($role eq 'cr') {
$select_menus{$roletype}->{'select2'}->{$role} =
&mt('Custom role');
} else {
$select_menus{$roletype}->{'select2'}->{$role} =
&Apache::lonnet::plaintext($role);
}
}
$select_menus{$roletype}->{'select2'}->{'Any'} = &mt('Any');
}
my $result = &Apache::loncommon::linked_select_forms
('studentform',(' 'x3).&mt('Role: '),$env{'form.roletype'},
'roletype','showrole',\%select_menus,['domain','author','course']);
return $result;
}
###############################################################
###############################################################
sub hidden_input {
my ($name,$value) = @_;
return ''."\n";
}
sub print_upload_manager_header {
my ($r,$datatoken,$distotal,$krbdefdom,$context,$permission)=@_;
my $javascript;
#
if (! exists($env{'form.upfile_associate'})) {
$env{'form.upfile_associate'} = 'forward';
}
if ($env{'form.associate'} eq 'Reverse Association') {
if ( $env{'form.upfile_associate'} ne 'reverse' ) {
$env{'form.upfile_associate'} = 'reverse';
} else {
$env{'form.upfile_associate'} = 'forward';
}
}
if ($env{'form.upfile_associate'} eq 'reverse') {
$javascript=&upload_manager_javascript_reverse_associate();
} else {
$javascript=&upload_manager_javascript_forward_associate();
}
#
# Deal with restored settings
my $password_choice = '';
if (exists($env{'form.ipwd_choice'}) &&
$env{'form.ipwd_choice'} ne '') {
# If a column was specified for password, assume it is for an
# internal password. This is a bug waiting to be filed (could be
# local or krb auth instead of internal) but I do not have the
# time to mess around with this now.
$password_choice = 'int';
}
#
my $groupslist;
if ($context eq 'course') {
$groupslist = &get_groupslist();
}
my $javascript_validations =
&javascript_validations('upload',$krbdefdom,$password_choice,undef,
$env{'request.role.domain'},$context,
$permission,$groupslist);
my $checked=(($env{'form.noFirstLine'})?' checked="checked" ':'');
$r->print(&mt('Total number of records found in file: [_1].',$distotal).
"
\n");
$r->print('
'.&mt('Change authentication for existing users to these settings?').'
'; } else { $Str .= "\n". &mt('Note: this will not take effect if the user already exists'). &Apache::loncommon::help_open_topic('Auth_Options'). "
\n"; } $Str .= &set_login($defdom,$krbform,$intform,$locform); my ($home_server_pick,$numlib) = &Apache::loncommon::home_server_form_item($defdom,'lcserver', 'default','hide'); if ($numlib > 1) { $Str .= '\n".$date_table."
\n"; if ($context eq 'domain') { $Str .= '\n".'
'."\n".
&mt('(only do if you know what you are doing.)')."\n";
if ($context eq 'domain') {
$output .= '
'."\n";
}
$output .= '
';
my @linkdests = ('aboutme');
if ($permission->{'cusr'}) {
push (@linkdests,'modify');
$output .= ''.$lt{'link'}.': ';
my $usernamelink = $env{'form.usernamelink'};
if ($usernamelink eq '') {
$usernamelink = 'aboutme';
}
foreach my $item (@linkdests) {
my $checkedstr = '';
if ($item eq $usernamelink) {
$checkedstr = ' checked="checked" ';
}
$output .= ' ';
}
$output .= '
';
} else {
$output .= &mt("Click on a username to view the user's personal page.").'
';
}
if ($actionselect) {
$output .= <<"END";
$lt{'ac'}: $actionselect
END my @allroles; if ($env{'form.showrole'} eq 'Any') { my $custom = 1; if ($context eq 'domain') { @allroles = &roles_by_context($setting,$custom); } else { @allroles = &roles_by_context($context,$custom); } } else { @allroles = ($env{'form.showrole'}); } foreach my $role (@allroles) { if ($context eq 'domain') { if ($setting eq 'domain') { if (&Apache::lonnet::allowed('c'.$role, $env{'request.role.domain'})) { $canchange{$role} = 1; } } } elsif ($context eq 'author') { if (&Apache::lonnet::allowed('c'.$role, $env{'user.domain'}.'/'.$env{'user.name'})) { $canchange{$role} = 1; } } elsif ($context eq 'course') { if (&Apache::lonnet::allowed('c'.$role,$env{'request.course.id'})) { $canchange{$role} = 1; } elsif ($env{'request.course.sec'} ne '') { if (&Apache::lonnet::allowed('c'.$role,$env{'request.course.id'}.'/'.$env{'request.course.sec'})) { $canchangesec{$role} = $env{'request.course.sec'}; } } } } } } $output .= "\n
\n". &Apache::loncommon::start_data_table(). &Apache::loncommon::start_data_table_header_row(); if ($mode eq 'autoenroll') { $output .= "
'.&mt('manual').' | |
'. &mt('Your Excel spreadsheet').' '.&mt('is ready for download').'.
'."\n"); } elsif ($mode eq 'csv') { close($CSVfile); $r->print(''. &mt('Your CSV file').' is ready for download.'. "\n"); $r->rflush(); } if ($mode eq 'autoenroll') { return ($usercount,$autocount,$manualcount,$lockcount,$unlockcount); } else { return ($usercount); } } sub print_username_link { my ($mode,$permission,$in) = @_; my $output; if ($mode eq 'autoenroll') { $output = $in->{'username'}; } elsif (!$permission->{'cusr'}) { $output = &Apache::loncommon::aboutmewrapper($in->{'username'}, $in->{'username'}, $in->{'domain'}); } else { $output = '{'username'}','$in->{'domain'}'".')" />'. $in->{'username'}.''; } return $output; } sub role_type_names { my %lt = &Apache::lonlocal::texthash ( 'domain' => 'Domain Roles', 'author' => 'Co-Author Roles', 'course' => 'Course Roles', ); return %lt; } sub select_actions { my ($context,$setting,$statusmode) = @_; my %lt = &Apache::lonlocal::texthash( revoke => "Revoke user roles", delete => "Delete user roles", reenable => "Re-enable expired user roles", activate => "Make future user roles active now", chgdates => "Change starting/ending dates", chgsec => "Change section associated with user roles", ); my ($output,$options,%choices); # FIXME Disable actions for now for roletype=course in domain context if ($context eq 'domain' && $setting eq 'course') { return; } if ($context eq 'course') { if ($env{'form.showrole'} ne 'Any') { if (!&Apache::lonnet::allowed('c'.$env{'form.showrole'}, $env{'request.course.id'})) { if ($env{'request.course.sec'} eq '') { return; } else { if (!&Apache::lonnet::allowed('c'.$env{'form.showrole'},$env{'request.course.id'}.'/'.$env{'request.course.sec'})) { return; } } } } } if ($statusmode eq 'Any') { $options .= ' '; $choices{'dates'} = 1; } else { if ($statusmode eq 'Future') { $options .= ' '; $choices{'dates'} = 1; } elsif ($statusmode eq 'Expired') { $options .= ' '; $choices{'dates'} = 1; } if ($statusmode eq 'Active' || $statusmode eq 'Future') { $options .= ' '; $choices{'dates'} = 1; } } if ($context eq 'domain') { $options .= ' '; } if (($context eq 'course') || ($context eq 'domain' && $setting eq 'course')) { if (($statusmode ne 'Expired') && ($env{'request.course.sec'} eq '')) { $options .= ' '; $choices{'sections'} = 1; } } if ($options) { $output = ''.&Apache::lonhtmlcommon::start_pick_box()."\n"; if ($mode eq 'upload') { my ($options,$cb_script,$coursepick) = &default_role_selector($context,1); $secbox .= &Apache::lonhtmlcommon::row_title('role','LC_oddrow_value'). $options. &Apache::lonhtmlcommon::row_closure(1)."\n"; } $secbox .= &Apache::lonhtmlcommon::row_title($rowtitle,'LC_oddrow_value')."\n"; if ($env{'request.course.sec'} eq '') { $secbox .= '
'.&mt('Existing sections')."\n".
' '.$sections_select.' | '.
&mt('New section').' '."\n". ''."\n". ''."\n". ' |
END
my %lt=&Apache::lonlocal::texthash('usrn' => "username",
'dom' => "domain",
'sn' => "student name",
'sec' => "section",
'start' => "start date",
'end' => "end date",
'groups' => "active groups",
);
if ($nosort) {
$r->print(&Apache::loncommon::start_data_table().
&Apache::loncommon::start_data_table_header_row());
$r->print(<$lt{'usrn'}
$lt{'dom'}
ID
$lt{'sn'}
$lt{'sec'}
$lt{'start'}
$lt{'end'}
$lt{'groups'}
END
$r->print(&Apache::loncommon::end_data_table_header_row());
} else {
$r->print(&Apache::loncommon::start_data_table().
&Apache::loncommon::start_data_table_header_row());
$r->print(<
$lt{'usrn'}
$lt{'dom'}
ID
$lt{'sn'}
$lt{'sec'}
$lt{'start'}
$lt{'end'}
$lt{'groups'}
END
$r->print(&Apache::loncommon::end_data_table_header_row());
}
#
# Sort the students
my %index;
my $i;
foreach (@$keylist) {
$index{$_} = $i++;
}
$index{'groups'} = scalar(@$keylist);
my $index = $index{$sortby};
my $second = $index{'username'};
my $third = $index{'domain'};
my @Sorted_Students = sort {
lc($classlist->{$a}->[$index]) cmp lc($classlist->{$b}->[$index])
||
lc($classlist->{$a}->[$second]) cmp lc($classlist->{$b}->[$second])
||
lc($classlist->{$a}->[$third]) cmp lc($classlist->{$b}->[$third])
} (keys(%$classlist));
foreach my $student (@Sorted_Students) {
my $error;
my $sdata = $classlist->{$student};
my $username = $sdata->[$index{'username'}];
my $domain = $sdata->[$index{'domain'}];
my $section = $sdata->[$index{'section'}];
my $name = $sdata->[$index{'fullname'}];
my $id = $sdata->[$index{'id'}];
my $start = $sdata->[$index{'start'}];
my $end = $sdata->[$index{'end'}];
my $groups = $classgroups->{$student};
my $active_groups;
if (ref($groups->{active}) eq 'HASH') {
$active_groups = join(', ',keys(%{$groups->{'active'}}));
}
if (! defined($start) || $start == 0) {
$start = &mt('none');
} else {
$start = &Apache::lonlocal::locallocaltime($start);
}
if (! defined($end) || $end == 0) {
$end = &mt('none');
} else {
$end = &Apache::lonlocal::locallocaltime($end);
}
my $status = $sdata->[$index{'status'}];
next if ($status ne 'Active');
if ($env{'request.course.sec'} ne '') {
if ($section ne $env{'request.course.sec'}) {
next;
}
}
my $studentkey = $student.':'.$section;
my $startitem = '';
#
$r->print(&Apache::loncommon::start_data_table_row());
$r->print(<<"END");
$username
$domain
$id
$name
$section
$start
$end
$active_groups
END
$r->print(&Apache::loncommon::end_data_table_row());
}
$r->print(&Apache::loncommon::end_data_table().'
');
%lt=&Apache::lonlocal::texthash(
'dp' => "Expire Users' Roles",
'ca' => "check all",
'ua' => "uncheck all",
);
$r->print(<<"END");
END return; } # # Print out the initial form to get the file containing a list of users # sub print_first_users_upload_form { my ($r,$context) = @_; my $str; $str = ''; $str .= ''; $str .= ''; $str .= "
\n"; $str .= ''."\n"; $str .= '
\n"; $str .= &Apache::loncommon::help_open_topic("Course_Create_Class_List", &mt("How do I create a users list from a spreadsheet")). "\n"); } elsif ($context eq 'author') { $r->print('
\n"); } else { $r->print('
\n");
}
my %counts = (
user => 0,
auth => 0,
role => 0,
);
my $flushc=0;
my %student=();
my (%curr_groups,@sections,@cleansec,@secs,$defaultwarn,$groupwarn);
my %userchg;
if ($context eq 'course' || $setting eq 'course') {
if ($context eq 'course') {
# Get information about course groups
%curr_groups = &Apache::longroup::coursegroups();
} elsif ($setting eq 'course') {
if ($cid) {
%curr_groups =
&Apache::longroup::coursegroups($env{'form.dcdomain'},
$env{'form.dccourse'});
}
}
# determine section number
if ($defaultsec =~ /,/) {
push(@sections,split(/,/,$defaultsec));
} else {
push(@sections,$defaultsec);
}
# remove non alphanumeric values from section
foreach my $item (@sections) {
$item =~ s/\W//g;
if ($item eq "none" || $item eq 'all') {
$defaultwarn = &mt('Default section name [_1] could not be used as it is a reserved word.',$item);
} elsif ($item ne '' && exists($curr_groups{$item})) {
$groupwarn = &mt('Default section name "[_1]" is the name of a course group. Section names and group names must be distinct.',$item);
} elsif ($item ne '') {
push(@cleansec,$item);
}
}
if ($defaultwarn) {
$r->print($defaultwarn.'
');
}
if ($groupwarn) {
$r->print($groupwarn.'
');
}
}
my (%curr_rules,%got_rules,%alerts);
my %customroles = &my_custom_roles();
my ($custom_ok,@permitted_roles) =
&roles_on_upload($context,%customroles);
# Get new users list
foreach my $line (@userdata) {
my %entries=&Apache::loncommon::record_sep($line);
# Determine user name
unless (($entries{$fields{'username'}} eq '') ||
(!defined($entries{$fields{'username'}}))) {
my ($fname, $mname, $lname,$gen) = ('','','','');
if (defined($fields{'names'})) {
($lname,$fname,$mname)=($entries{$fields{'names'}}=~
/([^\,]+)\,\s*(\w+)\s*(.*)$/);
} else {
if (defined($fields{'fname'})) {
$fname=$entries{$fields{'fname'}};
}
if (defined($fields{'mname'})) {
$mname=$entries{$fields{'mname'}};
}
if (defined($fields{'lname'})) {
$lname=$entries{$fields{'lname'}};
}
if (defined($fields{'gen'})) {
$gen=$entries{$fields{'gen'}};
}
}
if ($entries{$fields{'username'}}
ne &LONCAPA::clean_username($entries{$fields{'username'}})) {
$r->print('
'.
&mt('[_1]: Unacceptable username for user [_2] [_3] [_4] [_5]',
$entries{$fields{'username'}},$fname,$mname,$lname,$gen).
'');
next;
} else {
my $username = $entries{$fields{'username'}};
if (defined($fields{'sec'})) {
if (defined($entries{$fields{'sec'}})) {
my $item = $entries{$fields{'sec'}};
$item =~ s/(\s+$|^\s+)//g;
if ($item eq "none" || $item eq 'all') {
$r->print('
'.&mt('[_1]: Unable to enroll user [_2] [_3] [_4] [_5] in a section named "[_6]" - this is a reserved word.',$username,$fname,$mname,$lname,$gen,$item));
next;
} elsif (exists($curr_groups{$item})) {
$r->print('
'.&mt('[_1]: Unable to enroll user [_2] [_3] [_4] [_5] in a section named "[_6]" - this is a course group.',$username,$fname,$mname,$lname,$gen,$item).' '.&mt('Section names and group names must be distinct.'));
next;
} else {
push(@secs,$item);
}
}
}
if ($env{'request.course.sec'} ne '') {
@secs = ($env{'request.course.sec'});
if (ref($userlist{$username.':'.$domain}) eq 'ARRAY') {
my $currsec = $userlist{$username.':'.$domain}[$secidx];
if ($currsec ne $env{'request.course.sec'}) {
$r->print('
'.&mt('[_1]: Unable to enroll user [_2] [_3] [_4] [_5] in a section named "[_6]".',$username,$fname,$mname,$lname,$gen,$secs[0]).'
');
if ($currsec eq '') {
$r->print(&mt('This user already has an active/future student role in the course, unaffiliated to any section.'));
} else {
$r->print(&mt('This user already has an active/future role in section "[_1]" of the course.',$currsec));
}
$r->print('
'.&mt('Although your current role has privileges to add students to section "[_1]", you do not have privileges to modify existing enrollments in other sections.',$secs[0]).'
');
next;
}
}
} elsif ($context eq 'course' || $setting eq 'course') {
if (@secs == 0) {
@secs = @cleansec;
}
}
# determine id number
my $id='';
if (defined($fields{'id'})) {
if (defined($entries{$fields{'id'}})) {
$id=$entries{$fields{'id'}};
}
$id=~tr/A-Z/a-z/;
}
# determine email address
my $email='';
if (defined($fields{'email'})) {
if (defined($entries{$fields{'email'}})) {
$email=$entries{$fields{'email'}};
unless ($email=~/^[^\@]+\@[^\@]+$/) { $email=''; } }
}
# determine user password
my $password = $genpwd;
if (defined($fields{'ipwd'})) {
if ($entries{$fields{'ipwd'}}) {
$password=$entries{$fields{'ipwd'}};
}
}
# determine user role
my $role = '';
if (defined($fields{'role'})) {
if ($entries{$fields{'role'}}) {
if (grep(/^\Q$entries{$fields{'role'}}\E$/,@permitted_roles)) {
$role=$entries{$fields{'role'}};
$role =~ s/(\s+$|^\s+)//g;
}
if ($custom_ok) {
if ($customroles{$role}) {
$role = 'cr_'.$env{'user.domain'}.'_'.$env{'user.name'}.'_'.$entries{$fields{'role'}};
}
}
if ($role eq '') {
my $rolestr = join(', ',@permitted_roles);
$r->print('
'.
&mt('[_1]: You do not have permission to add the requested role [_2] for the user.',$entries{$fields{'username'}},$entries{$fields{'role'}}).'
'.&mt('Allowable role(s) is/are: [_1].',$rolestr)."\n");
next;
}
}
}
if ($role eq '') {
$role = $defaultrole;
}
# Clean up whitespace
foreach (\$domain,\$username,\$id,\$fname,\$mname,
\$lname,\$gen) {
$$_ =~ s/(\s+$|^\s+)//g;
}
# check against rules
my $checkid = 0;
my $newuser = 0;
my (%rulematch,%inst_results,%idinst_results);
my $uhome=&Apache::lonnet::homeserver($username,$domain);
if ($uhome eq 'no_host') {
$checkid = 1;
$newuser = 1;
my $checkhash;
my $checks = { 'username' => 1 };
$checkhash->{$username.':'.$domain} = { 'newuser' => 1, };
&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'}{$domain}) eq 'HASH') {
next if ($alerts{'username'}{$domain}{$username});
}
}
} else {
if ($context eq 'course' || $context eq 'author') {
if ($role eq '') {
my @checkroles;
foreach my $role (@poss_roles) {
my $endkey;
if ($role ne 'st') {
$endkey = ':'.$role;
}
if (exists($userlist{$username.':'.$domain.$endkey})) {
if (!grep(/^\Q$role\E$/,@checkroles)) {
push(@checkroles,$role);
}
}
}
if (@checkroles > 0) {
%canmodify = &can_modify_userinfo($context,$domain,\@userinfo,\@checkroles);
}
} elsif (ref($modifiable_fields{$role}) eq 'HASH') {
%canmodify = %{$modifiable_fields{$role}};
}
}
my @newinfo = (\$fname,\$mname,\$lname,\$gen,\$email,\$id);
for (my $i=0; $i<@userinfo; $i++) {
if (${$newinfo[$i]} ne '') {
if (!$canmodify{$userinfo[$i]}) {
${$newinfo[$i]} = '';
}
}
}
}
if ($id ne '') {
if (!$newuser) {
my %idhash = &Apache::lonnet::idrget($domain,($username));
if ($idhash{$username} ne $id) {
$checkid = 1;
}
}
if ($checkid) {
my $checkhash;
my $checks = { 'id' => 1 };
$checkhash->{$username.':'.$domain} = { 'newuser' => $newuser,
'id' => $id };
&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'}{$domain}) eq 'HASH') {
next if ($alerts{'id'}{$domain}{$id});
}
}
}
}
if ($password || $env{'form.login'} eq 'loc') {
my $multiple = 0;
my ($userresult,$authresult,$roleresult,$idresult);
my (%userres,%authres,%roleres,%idres);
if ($role eq 'st') {
my $sec;
if ($cid) {
if (@secs > 0) {
$sec = $secs[0];
}
&modifystudent($domain,$username,$cid,$sec,
$desiredhost);
$roleresult =
&Apache::lonnet::modifystudent
($domain,$username,$id,$amode,$password,
$fname,$mname,$lname,$gen,$sec,$enddate,
$startdate,$env{'form.forceid'},
$desiredhost,$email,'manual','',$cid);
$userresult = $roleresult;
}
} else {
if (($context eq 'course') ||
(grep(/^\Q$role\E$/,@courseroles))) {
if (!$cid) {
next;
}
}
my $singlesec;
if ((grep(/^\Q$role\E$/,@courseroles)) && ($role ne 'cc')) {
if (@secs > 1) {
$multiple = 1;
foreach my $sec (@secs) {
($userres{$sec},$authres{$sec},$roleres{$sec},$idres{$sec}) =
&modifyuserrole($context,$setting,
$changeauth,$cid,$domain,$username,
$id,$amode,$password,$fname,
$mname,$lname,$gen,$sec,
$env{'form.forceid'},$desiredhost,
$email,$role,$enddate,$startdate,$checkid);
}
} elsif (@secs > 0) {
$singlesec = $secs[0];
}
}
if (!$multiple) {
($userresult,$authresult,$roleresult,$idresult) =
&modifyuserrole($context,$setting,
$changeauth,$cid,$domain,$username,
$id,$amode,$password,$fname,
$mname,$lname,$gen,$singlesec,
$env{'form.forceid'},$desiredhost,
$email,$role,$enddate,$startdate,$checkid);
}
}
if ($multiple) {
foreach my $sec (sort(keys(%userres))) {
$flushc =
&user_change_result($r,$userres{$sec},$authres{$sec},
$roleres{$sec},$idres{$sec},\%counts,$flushc,
$username,\%userchg);
}
} else {
$flushc =
&user_change_result($r,$userresult,$authresult,
$roleresult,$idresult,\%counts,$flushc,
$username,%userchg);
}
} else {
if ($context eq 'course') {
$r->print('
'.
&mt('[_1]: Unable to enroll. No password specified.',$username)
);
} elsif ($context eq 'author') {
$r->print('
'.
&mt('[_1]: Unable to add co-author. No password specified.',$username)
);
} else {
$r->print('
'.
&mt('[_1]: Unable to add user. No password specified.',$username)
);
}
}
}
}
} # end of foreach (@userdata)
# Flush the course logs so reverse user roles immediately updated
&Apache::lonnet::flushcourselogs();
$r->print("
\n".&mt('Processed [_1] user(s).',$counts{'user'}). "
\n"); if ($counts{'role'} > 0) { $r->print("\n". &mt('Roles added for [_1] users. If user is active, the new role will be available when the user next logs in to LON-CAPA.',$counts{'role'})."
\n"); } if ($counts{'auth'} > 0) { $r->print("\n". &mt('Authentication changed for [_1] existing users.', $counts{'auth'})."
\n"); } $r->print(&print_namespacing_alerts($domain,\%alerts,\%curr_rules)); $r->print(''); ##################################### # Drop students # ##################################### if ($env{'form.fullup'} eq 'yes') { $r->print(''.&mt("$result_text{'ok'}{$choice} role(s) for [quant,_1,user,users,users].",$count).'
'); if ($count > 0) { if ($choice eq 'revoke' || $choice eq 'drop') { $r->print(''.&mt('Re-enabling will re-activate data for the role.
')); } # Flush the course logs so reverse user roles immediately updated &Apache::lonnet::flushcourselogs(); } if ($env{'form.makedatesdefault'}) { if ($choice eq 'chgdates' || $choice eq 'reenable' || $choice eq 'activate') { $r->print(&make_dates_default($startdate,$enddate)); } } } sub classlist_drop { my ($scope,$uname,$udom,$now,$action) = @_; my ($cdom,$cnum) = ($scope=~m{^/($match_domain)/($match_courseid)}); my $cid=$cdom.'_'.$cnum; my $user = $uname.':'.$udom; if ($action eq 'drop') { if (!&active_student_roles($cnum,$cdom,$uname,$udom)) { my $result = &Apache::lonnet::cput('classlist', { $user => $now }, $env{'course.'.$cid.'.domain'}, $env{'course.'.$cid.'.num'}); return &mt('Drop from classlist: [_1]', ''.$result.'').'