# The LearningOnline Network with CAPA
# Utility functions for managing LON-CAPA user accounts
#
# $Id: lonuserutils.pm,v 1.2 2007/11/06 04:39:19 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 LONCAPA();
###############################################################
###############################################################
# 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 $cdom = $env{'course.'.$courseid.'.domain'};
my $cnum = $env{'course.'.$courseid.'.num'};
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);
$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) = @_;
my ($scope,$userresult,$authresult,$roleresult);
if ($setting eq 'course' || $context eq 'course') {
$scope = '/'.$cid;
$scope =~ s/\_/\//g;
if ($role ne 'cc' && $sec ne '') {
$scope .='/'.$sec;
}
} elsif ($setting eq 'domain') {
$scope = '/'.$env{'request.role.domain'}.'/';
} elsif ($setting eq 'construction_space') {
$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) && (&Apache::lonnet::allowed('mau',$udom))) {
if ((($umode =~ /^krb4|krb5|internal$/) && $upass ne '') ||
($umode eq 'localauth')) {
$authresult = &Apache::lonnet::modifyuserauth($udom,$uname,$umode,$upass);
}
}
}
}
$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 '') {
$roleresult = &Apache::lonnet::assignrole($udom,$uname,$scope,
$role,$end,$start);
}
}
return ($userresult,$authresult,$roleresult);
}
###############################################################
###############################################################
# 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','construction_space','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 'construction_space') {
@roles = &construction_space_roles();
} else {
@roles = &course_roles('domain');
}
my $order = ['Any',@roles];
$select_menus{$roletype}->{'order'} = $order;
foreach my $role (@roles) {
$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','construction_space','course']);
return $result;
}
###############################################################
###############################################################
sub hidden_input {
my ($name,$value) = @_;
return ''."\n";
}
sub print_upload_manager_header {
my ($r,$datatoken,$distotal,$krbdefdom,$context)=@_;
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 $javascript_validations =
&javascript_validations('auth',$krbdefdom,$password_choice,undef,
$env{'request.role.domain'});
my $checked=(($env{'form.noFirstLine'})?' checked="checked" ':'');
$r->print(&mt('Total number of records found in file: [_1].',$distotal).
" \n");
$r->print('
'.
&mt('Identify fields in uploaded list')."
\n");
$r->print(&mt('Enter as many fields as you can. The system will inform you and bring you back to this page, if the data selected are insufficient to add users.')." \n");
$r->print(&hidden_input('action','upload').
&hidden_input('state','got_file').
&hidden_input('associate','').
&hidden_input('datatoken',$datatoken).
&hidden_input('fileupload',$env{'form.fileupload'}).
&hidden_input('upfiletype',$env{'form.upfiletype'}).
&hidden_input('upfile_associate',$env{'form.upfile_associate'}));
$r->print(' ');
$r->print('');
$r->print("
\n".
'');
}
###############################################################
###############################################################
sub javascript_validations {
my ($mode,$krbdefdom,$curr_authtype,$curr_authfield,$domain)=@_;
my $authheader;
if ($mode eq 'auth') {
my %param = ( formname => 'studentform',
kerb_def_dom => $krbdefdom,
curr_authtype => $curr_authtype);
$authheader = &Apache::loncommon::authform_header(%param);
} elsif ($mode eq 'createcourse') {
my %param = ( formname => 'ccrs',
kerb_def_dom => $krbdefdom,
curr_authtype => $curr_authtype );
$authheader = &Apache::loncommon::authform_header(%param);
} elsif ($mode eq 'modifycourse') {
my %param = ( formname => 'cmod',
kerb_def_dom => $krbdefdom,
mode => 'modifycourse',
curr_authtype => $curr_authtype,
curr_autharg => $curr_authfield );
$authheader = &Apache::loncommon::authform_header(%param);
}
my %alert = &Apache::lonlocal::texthash
(username => 'You need to specify the username field.',
authen => 'You must choose an authentication type.',
krb => 'You need to specify the Kerberos domain.',
ipass => 'You need to specify the initial password.',
name => 'The optional name field was not specified.',
snum => 'The optional ID number field was not specified.',
section => 'The optional section field was not specified.',
email => 'The optional email address field was not specified.',
role => 'The optional role field was not specified.',
continue => 'Continue adding users?',
);
# my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
my $function_name =(< 1) {
$auth_checks .= (<=2) && (tw<=6)) { foundname=1; }
if (tw==7) { foundid=1; }
if (tw==8) { foundsec=1; }
if (tw==9) { foundpwd=1; }
if (tw==10) { foundemail=1; }
if (tw==11) { foundrole=1; }
}
verify_message(vf,founduname,foundpwd,foundname,foundid,foundsec,foundemail,foundrole);
}
//
// vf = this.form
// tf = column number
//
// values of nw
//
// 0 = none
// 1 = username
// 2 = names (lastname, firstnames)
// 3 = fname (firstname)
// 4 = mname (middlename)
// 5 = lname (lastname)
// 6 = gen (generation)
// 7 = id
// 8 = section
// 9 = ipwd (password)
// 10 = email address
// 11 = role
function flip(vf,tf) {
var nw=eval('vf.f'+tf+'.selectedIndex');
var i;
// make sure no other columns are labeled the same as this one
for (i=0;i<=vf.nfields.value;i++) {
if ((i!=tf) && (eval('vf.f'+i+'.selectedIndex')==nw)) {
eval('vf.f'+i+'.selectedIndex=0;')
}
}
// If we set this to 'lastname, firstnames', clear out all the ones
// set to 'fname','mname','lname','gen' (3,4,5,6) currently.
if (nw==2) {
for (i=0;i<=vf.nfields.value;i++) {
if ((eval('vf.f'+i+'.selectedIndex')>=3) &&
(eval('vf.f'+i+'.selectedIndex')<=6)) {
eval('vf.f'+i+'.selectedIndex=0;')
}
}
}
// If we set this to one of 'fname','mname','lname','gen' (3,4,5,6),
// clear out any that are set to 'lastname, firstnames' (2)
if ((nw>=3) && (nw<=6)) {
for (i=0;i<=vf.nfields.value;i++) {
if (eval('vf.f'+i+'.selectedIndex')==2) {
eval('vf.f'+i+'.selectedIndex=0;')
}
}
}
// If we set the password, make the password form below correspond to
// the new value.
if (nw==9) {
changed_radio('int',document.studentform);
set_auth_radio_buttons('int',document.studentform);
vf.intarg.value='';
vf.krbarg.value='';
vf.locarg.value='';
}
}
function clearpwd(vf) {
var i;
for (i=0;i<=vf.nfields.value;i++) {
if (eval('vf.f'+i+'.selectedIndex')==9) {
eval('vf.f'+i+'.selectedIndex=0;')
}
}
}
ENDPICK
}
###############################################################
###############################################################
sub upload_manager_javascript_reverse_associate {
return(<=1) && (i<=5)) && tw!=0 ) { foundname=1; }
if (i==6 && tw!=0) { foundid=1; }
if (i==7 && tw!=0) { foundsec=1; }
if (i==8 && tw!=0) { foundpwd=1; }
if (i==9 && tw!=0) { foundrole=1; }
}
verify_message(vf,founduname,foundpwd,foundname,foundid,foundsec,foundrole);
}
function flip(vf,tf) {
var nw=eval('vf.f'+tf+'.selectedIndex');
var i;
// picked the all one name field, reset the other name ones to blank
if (tf==1 && nw!=0) {
for (i=2;i<=5;i++) {
eval('vf.f'+i+'.selectedIndex=0;')
}
}
//picked one of the piecewise name fields, reset the all in
//one field to blank
if ((tf>=2) && (tf<=5) && (nw!=0)) {
eval('vf.f1.selectedIndex=0;')
}
// intial password specified, pick internal authentication
if (tf==8 && nw!=0) {
changed_radio('int',document.studentform);
set_auth_radio_buttons('int',document.studentform);
vf.krbarg.value='';
vf.intarg.value='';
vf.locarg.value='';
}
}
function clearpwd(vf) {
var i;
if (eval('vf.f8.selectedIndex')!=0) {
eval('vf.f8.selectedIndex=0;')
}
}
ENDPICK
}
###############################################################
###############################################################
sub print_upload_manager_footer {
my ($r,$i,$keyfields,$defdom,$today,$halfyear,$context)=@_;
my $formname;
if ($context eq 'course') {
$formname = 'document.studentform';
} elsif ($context eq 'construction_space') {
$formname = 'document.studentform';
} elsif ($context eq 'domain') {
$formname = 'document.studentform';
}
my ($krbdef,$krbdefdom) =
&Apache::loncommon::get_kerberos_defaults($defdom);
my %param = ( formname => $formname,
kerb_def_dom => $krbdefdom,
kerb_def_auth => $krbdef
);
if (exists($env{'form.ipwd_choice'}) &&
defined($env{'form.ipwd_choice'}) &&
$env{'form.ipwd_choice'} ne '') {
$param{'curr_authtype'} = 'int';
}
my $krbform = &Apache::loncommon::authform_kerberos(%param);
my $intform = &Apache::loncommon::authform_internal(%param);
my $locform = &Apache::loncommon::authform_local(%param);
my $date_table = &date_setting_table(undef,undef,$context);
my $Str = "\n".'
\n".' '."\n".
&mt('(only do if you know what you are doing.)')."
\n";
$Str .= '
';
$r->print($Str);
return;
}
###############################################################
###############################################################
sub print_upload_manager_form {
my ($r,$context) = @_;
my $firstLine;
my $datatoken;
if (!$env{'form.datatoken'}) {
$datatoken=&Apache::loncommon::upfile_store($r);
} else {
$datatoken=$env{'form.datatoken'};
&Apache::loncommon::load_tmp_file($r);
}
my @records=&Apache::loncommon::upfile_record_sep();
if($env{'form.noFirstLine'}){
$firstLine=shift(@records);
}
my $total=$#records;
my $distotal=$total+1;
my $today=time;
my $halfyear=$today+15552000;
#
# Restore memorized settings
my $col_setting_names = { 'username_choice' => 'scalar', # column settings
'names_choice' => 'scalar',
'fname_choice' => 'scalar',
'mname_choice' => 'scalar',
'lname_choice' => 'scalar',
'gen_choice' => 'scalar',
'id_choice' => 'scalar',
'sec_choice' => 'scalar',
'ipwd_choice' => 'scalar',
'email_choice' => 'scalar',
'role_choice' => 'scalar',
};
my $defdom = $env{'request.role.domain'};
if ($context eq 'course') {
&Apache::loncommon::restore_course_settings('enrollment_upload',
$col_setting_names);
} else {
&Apache::loncommon::restore_settings($context,'user_upload',
$col_setting_names);
}
#
# Determine kerberos parameters as appropriate
my ($krbdef,$krbdefdom) =
&Apache::loncommon::get_kerberos_defaults($defdom);
#
&print_upload_manager_header($r,$datatoken,$distotal,$krbdefdom,$context);
my $i;
my $keyfields;
if ($total>=0) {
my @field=
(['username',&mt('Username'), $env{'form.username_choice'}],
['names',&mt('Last Name, First Names'),$env{'form.names_choice'}],
['fname',&mt('First Name'), $env{'form.fname_choice'}],
['mname',&mt('Middle Names/Initials'),$env{'form.mname_choice'}],
['lname',&mt('Last Name'), $env{'form.lname_choice'}],
['gen', &mt('Generation'), $env{'form.gen_choice'}],
['id', &mt('ID/Student Number'),$env{'form.id_choice'}],
['sec', &mt('Section'), $env{'form.sec_choice'}],
['ipwd', &mt('Initial Password'),$env{'form.ipwd_choice'}],
['email',&mt('E-mail Address'), $env{'form.email_choice'}],
['role',&mt('Role'), $env{'form.role_choice'}]);
if ($env{'form.upfile_associate'} eq 'reverse') {
&Apache::loncommon::csv_print_samples($r,\@records);
$i=&Apache::loncommon::csv_print_select_table($r,\@records,
\@field);
foreach (@field) {
$keyfields.=$_->[0].',';
}
chop($keyfields);
} else {
unshift(@field,['none','']);
$i=&Apache::loncommon::csv_samples_select_table($r,\@records,
\@field);
my %sone=&Apache::loncommon::record_sep($records[0]);
$keyfields=join(',',sort(keys(%sone)));
}
}
$r->print('
');
&print_upload_manager_footer($r,$i,$keyfields,$defdom,$today,$halfyear,
$context);
}
sub setup_date_selectors {
my ($starttime,$endtime,$mode) = @_;
if (! defined($starttime)) {
$starttime = time;
unless ($mode eq 'create_enrolldates' || $mode eq 'create_defaultdates') {
if (exists($env{'course.'.$env{'request.course.id'}.
'.default_enrollment_start_date'})) {
$starttime = $env{'course.'.$env{'request.course.id'}.
'.default_enrollment_start_date'};
}
}
}
if (! defined($endtime)) {
$endtime = time+(6*30*24*60*60); # 6 months from now, approx
unless ($mode eq 'createcourse') {
if (exists($env{'course.'.$env{'request.course.id'}.
'.default_enrollment_end_date'})) {
$endtime = $env{'course.'.$env{'request.course.id'}.
'.default_enrollment_end_date'};
}
}
}
my $startdateform = &Apache::lonhtmlcommon::date_setter('studentform',
'startdate',
$starttime);
my $enddateform = &Apache::lonhtmlcommon::date_setter('studentform',
'enddate',
$endtime);
if ($mode eq 'create_enrolldates') {
$startdateform = &Apache::lonhtmlcommon::date_setter('ccrs',
'startenroll',
$starttime);
$enddateform = &Apache::lonhtmlcommon::date_setter('ccrs',
'endenroll',
$endtime);
}
if ($mode eq 'create_defaultdates') {
$startdateform = &Apache::lonhtmlcommon::date_setter('ccrs',
'startaccess',
$starttime);
$enddateform = &Apache::lonhtmlcommon::date_setter('ccrs',
'endaccess',
$endtime);
}
return ($startdateform,$enddateform);
}
sub get_dates_from_form {
my $startdate = &Apache::lonhtmlcommon::get_date_from_form('startdate');
my $enddate = &Apache::lonhtmlcommon::get_date_from_form('enddate');
if ($env{'form.no_end_date'}) {
$enddate = 0;
}
return ($startdate,$enddate);
}
sub date_setting_table {
my ($starttime,$endtime,$mode) = @_;
my ($startform,$endform)=&setup_date_selectors($starttime,$endtime,$mode);
my $dateDefault;
if ($mode eq 'create_enrolldates' || $mode eq 'create_defaultdates') {
$dateDefault = ' ';
} elsif ($mode ne 'construction_space' && $mode ne 'domain') {
$dateDefault = ''.
'';
}
my $perpetual = '';
if ($mode eq 'create_enrolldates') {
$perpetual = ' ';
}
my $result = &Apache::lonhtmlcommon::start_pick_box()."\n".
&Apache::lonhtmlcommon::row_title(&mt('Starting Date'),
'LC_oddrow_value')."\n".
$startform."\n".
&Apache::lonhtmlcommon::row_closure(1).
&Apache::lonhtmlcommon::row_title(&mt('Ending Date'),
'LC_oddrow_value')."\n".
$endform.' '.$perpetual.
&Apache::lonhtmlcommon::row_closure(1).
&Apache::lonhtmlcommon::end_pick_box().' ';
if ($dateDefault) {
$result .= $dateDefault.' '."\n";
}
return $result;
}
sub make_dates_default {
my ($startdate,$enddate,$context) = @_;
my $result = '';
if ($context eq 'course') {
my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
my $put_result = &Apache::lonnet::put('environment',
{'default_enrollment_start_date'=>$startdate,
'default_enrollment_end_date' =>$enddate},$dom,$crs);
if ($put_result eq 'ok') {
$result .= "Set default start and end dates for course ";
#
# Refresh the course environment
&Apache::lonnet::coursedescription($env{'request.course.id'},
{'freshen_cache' => 1});
} else {
$result .= &mt('Unable to set default dates for course').":".$put_result.
' ';
}
}
return $result;
}
sub default_role_selector {
my ($context,$checkpriv) = @_;
my %customroles;
my ($options,$coursepick,$cb_jscript);
if ($context ne 'construction_space') {
%customroles = &my_custom_roles();
}
my %lt=&Apache::lonlocal::texthash(
'rol' => "Role",
'grs' => "Section",
'exs' => "Existing sections",
'new' => "New section",
);
$options = '';
return ($options,$cb_jscript,$coursepick);
}
sub default_course_roles {
my ($context,$checkpriv,%customroles) = @_;
my $output;
my @roles = &course_roles($context,$checkpriv);
foreach my $role (@roles) {
my $plrole=&Apache::lonnet::plaintext($role);
$output .= ' ';
}
if (keys(%customroles) > 0) {
my %customroles = &my_custom_roles();
foreach my $cust (sort(keys(%customroles))) {
my $custrole='cr_cr_'.$env{'user.domain'}.
'_'.$env{'user.name'}.'_'.$cust;
$output .= ' ';
}
}
return $output;
}
sub construction_space_roles {
my ($checkpriv) = @_;
my @allroles = ('ca','aa');
my @roles;
if ($checkpriv) {
foreach my $role (@allroles) {
if (&Apache::lonnet::allowed('c'.$role,$env{'user.domain'}.'/'.$env{'user.name'})) {
push(@roles,$role);
}
}
return @roles;
} else {
return @allroles;
}
}
sub domain_roles {
my ($checkpriv) = @_;
my @allroles = ('dc','li','dg','au','sc');
my @roles;
if ($checkpriv) {
foreach my $role (@allroles) {
if (&Apache::lonnet::allowed('c'.$role,$env{'request.role.domain'})) {
push(@roles,$role);
}
}
return @roles;
} else {
return @allroles;
}
}
sub course_roles {
my ($context,$checkpriv) = @_;
my @allroles = ('st','ta','ep','in','cc');
my @roles;
if ($context eq 'domain') {
@roles = @allroles;
} elsif ($context eq 'course') {
if ($env{'request.course.id'}) {
if ($checkpriv) {
foreach my $role (@allroles) {
if (&Apache::lonnet::allowed('c'.$role,$env{'request.course.id'})) {
push(@roles,$role);
} else {
if ($role ne 'cc' && $env{'request.course.section'} ne '') {
if (!&Apache::lonnet::allowed('c'.$role,
$env{'request.course.id'}.'/'.
$env{'request.course.section'})) {
push(@roles,$role);
}
}
}
}
} else {
@roles = @allroles;
}
}
}
return @roles;
}
sub curr_role_permissions {
my ($context,$setting,$checkpriv) = @_;
my @roles;
if ($context eq 'construction_space') {
@roles = &construction_space_roles($checkpriv);
} elsif ($context eq 'domain') {
if ($setting eq 'course') {
@roles = &course_roles($context,$checkpriv);
} else {
@roles = &domain_roles($checkpriv);
}
} elsif ($context eq 'course') {
@roles = &course_roles($context,$checkpriv);
}
return @roles;
}
# ======================================================= Existing Custom Roles
sub my_custom_roles {
my %returnhash=();
my %rolehash=&Apache::lonnet::dump('roles');
foreach my $key (keys %rolehash) {
if ($key=~/^rolesdef\_(\w+)$/) {
$returnhash{$1}=$1;
}
}
return %returnhash;
}
sub print_userlist {
my ($r,$mode,$permission,$context,$formname,$totcodes,$codetitles,
$idlist,$idlist_titles) = @_;
my $format = $env{'form.output'};
if (! exists($env{'form.sortby'})) {
$env{'form.sortby'} = 'username';
}
if ($env{'form.Status'} !~ /^(Any|Expired|Active|Future)$/) {
$env{'form.Status'} = 'Active';
}
my $status_select = &Apache::lonhtmlcommon::StatusOptions
($env{'form.Status'});
if ($env{'form.showrole'} eq '') {
$env{'form.showrole'} = 'Any';
}
if (! defined($env{'form.output'}) ||
$env{'form.output'} !~ /^(csv|excel|html)$/ ) {
$env{'form.output'} = 'html';
}
my @statuses;
if ($env{'form.Status'} eq 'Any') {
@statuses = ('previous','active','future');
} elsif ($env{'form.Status'} eq 'Expired') {
@statuses = ('previous');
} elsif ($env{'form.Status'} eq 'Active') {
@statuses = ('active');
} elsif ($env{'form.Status'} eq 'Future') {
@statuses = ('future');
}
# if ($context eq 'course') {
# $r->print(&display_adv_courseroles());
# }
#
# Interface output
$r->print('');
}
sub list_submit_button {
my ($text) = @_;
return '';
}
sub gather_userinfo {
my ($context,$format,$userlist,$indexhash,$userinfo,$rolehash) = @_;
foreach my $item (keys(%{$rolehash})) {
@{$userlist->{$item}} = ();
my %userdata;
if ($context eq 'construction_space' || $context eq 'course') {
($userdata{'username'},$userdata{'domain'},$userdata{'role'}) =
split(/:/,$item);
($userdata{'start'},$userdata{'end'})=split(/:/,$rolehash->{$item});
&build_user_record(\%userdata,$userinfo,$indexhash,$item,$userlist);
} elsif ($context eq 'domain') {
if ($env{'form.roletype'} eq 'domain') {
($userdata{'role'},$userdata{'username'},$userdata{'domain'}) =
split(/:/,$item);
($userdata{'end'},$userdata{'start'})=split(/:/,$rolehash->{$item});
&build_user_record(\%userdata,$userinfo,$indexhash,$item,$userlist);
} elsif ($env{'form.roletype'} eq 'construction_space') {
if (ref($rolehash->{$item}) eq 'HASH') {
$userdata{'extent'} = $item;
foreach my $key (keys(%{$rolehash->{$item}})) {
($userdata{'username'},$userdata{'domain'},$userdata{'role'}) = split(/:/,$key);
($userdata{'start'},$userdata{'end'}) =
split(/:/,$rolehash->{$item}{$key});
my $uniqid = $key.':'.$item;
&build_user_record(\%userdata,$userinfo,$indexhash,$uniqid,$userlist);
}
}
} elsif ($env{'form.roletype'} eq 'course') {
($userdata{'username'},$userdata{'domain'},$userdata{'role'}) =
split(/:/,$item);
if (ref($rolehash->{$item}) eq 'HASH') {
foreach my $cid (sort(keys(%{$rolehash->{$item}}))) {
if (ref($rolehash->{$item}{$cid}) eq 'HASH') {
my $spanstart = '';
my $spanend = '; ';
my $space = ', ';
if ($format eq 'html' || $format eq 'view') {
$spanstart = '';
$spanend = ' ';
$space = ', ';
}
$userdata{'extent'} .= $spanstart.
$rolehash->{$item}{$cid}{'desc'}.$space;
if (ref($rolehash->{$item}{$cid}{'secs'}) eq 'HASH') {
foreach my $sec (sort(keys(%{$rolehash->{$item}{$cid}{'secs'}}))) {
$userdata{'extent'} .= $sec.$space.$rolehash->{$item}{$cid}{'secs'}{$sec}.$spanend;
}
}
}
}
}
&build_user_record(\%userdata,$userinfo,$indexhash,$item,$userlist);
}
}
}
return;
}
sub build_user_record {
my ($userdata,$userinfo,$indexhash,$record_key,$userlist) = @_;
&process_date_info($userdata);
my $username = $userdata->{'username'};
my $domain = $userdata->{'domain'};
if (ref($userinfo->{$username.':'.$domain}) eq 'HASH') {
$userdata->{'fullname'} =
$userinfo->{$username.':'.$domain}{'fullname'};
$userdata->{'id'} = $userinfo->{$username.':'.$domain}{'id'};
} else {
&aggregate_user_info($domain,$username,$userinfo);
$userdata->{'fullname'} = $userinfo->{$username.':'.$domain}{'fullname'};
$userdata->{'id'} = $userinfo->{$username.':'.$domain}{'id'};
}
foreach my $key (keys(%{$indexhash})) {
if (defined($userdata->{$key})) {
$userlist->{$record_key}[$indexhash->{$key}] = $userdata->{$key};
}
}
return;
}
sub courses_selector {
my ($cdom,$formname) = @_;
my %coursecodes = ();
my %codes = ();
my @codetitles = ();
my %cat_titles = ();
my %cat_order = ();
my %idlist = ();
my %idnums = ();
my %idlist_titles = ();
my $caller = 'global';
my $totcodes = 0;
my $format_reply;
my $jscript = '';
my $totcodes =
&Apache::courseclassifier::retrieve_instcodes(\%coursecodes,
$cdom,$totcodes);
if ($totcodes > 0) {
$format_reply =
&Apache::lonnet::auto_instcode_format($caller,$cdom,\%coursecodes,
\%codes,\@codetitles,\%cat_titles,\%cat_order);
if ($format_reply eq 'ok') {
my $numtypes = @codetitles;
&Apache::courseclassifier::build_code_selections(\%codes,\@codetitles,\%cat_titles,\%cat_order,\%idlist,\%idnums,\%idlist_titles);
my ($scripttext,$longtitles) = &Apache::courseclassifier::javascript_definitions(\@codetitles,\%idlist,\%idlist_titles,\%idnums,\%cat_titles);
my $longtitles_str = join('","',@{$longtitles});
my $allidlist = $idlist{$codetitles[0]};
$jscript .= &Apache::courseclassifier::courseset_js_start($formname,$longtitles_str,$allidlist);
$jscript .= $scripttext;
$jscript .= &Apache::courseclassifier::javascript_code_selections($formname,@codetitles);
}
}
my $cb_jscript = &Apache::loncommon::coursebrowser_javascript($cdom);
my %elements = (
Year => 'selectbox',
coursepick => 'radio',
coursetotal => 'text',
courselist => 'text',
);
$jscript .= &Apache::lonhtmlcommon::set_form_elements(\%elements);
if ($env{'form.coursepick'} eq 'category') {
$jscript .= qq|
function setCourseCat(formname) {
if (formname.Year.options[formname.Year.selectedIndex].value == -1) {
return;
}
courseSet('Year');
for (var j=0; j 1) {
my @course_ids = split(/&&/,$env{'form.courselist'});
foreach my $cid (@course_ids) {
$courses{$cid} = '';
}
} else {
$courses{$env{'form.courselist'}} = '';
}
}
return %courses;
}
sub instcode_from_coursefilter {
my $instcode = '';
my @cats = ('Semester','Year','Department','Number');
foreach my $category (@cats) {
if (defined($env{'form.'.$category})) {
unless ($env{'form.'.$category} eq '-1') {
$instcode .= $env{'form.'.$category};
}
}
}
if ($instcode eq '') {
$instcode = '.';
}
return $instcode;
}
sub display_adv_courseroles {
my $output;
#
# List course personnel
my %coursepersonnel =
&Apache::lonnet::get_course_adv_roles($env{'request.course.id'});
#
$output = ' '.&Apache::loncommon::start_data_table();
foreach my $role (sort(keys(%coursepersonnel))) {
next if ($role =~ /^\s*$/);
$output .= &Apache::loncommon::start_data_table_row().
'
'.$role.'
';
foreach my $user (split(',',$coursepersonnel{$role})) {
my ($puname,$pudom)=split(':',$user);
$output .= ' '.&Apache::loncommon::aboutmewrapper(
&Apache::loncommon::plainname($puname,$pudom),
$puname,$pudom);
}
$output .= '
'.&Apache::loncommon::end_data_table_row();
}
$output .= &Apache::loncommon::end_data_table();
}
sub make_keylist_array {
my ($index,$keylist);
$index->{'domain'} = &Apache::loncoursedata::CL_SDOM();
$index->{'username'} = &Apache::loncoursedata::CL_SNAME();
$index->{'end'} = &Apache::loncoursedata::CL_END();
$index->{'start'} = &Apache::loncoursedata::CL_START();
$index->{'id'} = &Apache::loncoursedata::CL_ID();
$index->{'section'} = &Apache::loncoursedata::CL_SECTION();
$index->{'fullname'} = &Apache::loncoursedata::CL_FULLNAME();
$index->{'status'} = &Apache::loncoursedata::CL_STATUS();
$index->{'type'} = &Apache::loncoursedata::CL_TYPE();
$index->{'lockedtype'} = &Apache::loncoursedata::CL_LOCKEDTYPE();
$index->{'groups'} = &Apache::loncoursedata::CL_GROUP();
$index->{'email'} = &Apache::loncoursedata::CL_PERMANENTEMAIL();
$index->{'role'} = &Apache::loncoursedata::CL_ROLE();
$index->{'extent'} = &Apache::loncoursedata::CL_EXTENT();
foreach my $key (keys(%{$index})) {
$keylist->[$index->{$key}] = $key;
}
return ($index,$keylist);
}
sub aggregate_user_info {
my ($udom,$uname,$userinfo) = @_;
my %info=&Apache::lonnet::get('environment',
['firstname','middlename',
'lastname','generation','id'],
$udom,$uname);
my ($tmp) = keys(%info);
my ($fullname,$id);
if ($tmp =~/^(con_lost|error|no_such_host)/i) {
$fullname = 'not available';
$id = 'not available';
&Apache::lonnet::logthis('unable to retrieve environment '.
'for '.$uname.':'.$udom);
} else {
$fullname = &Apache::lonnet::format_name(@info{qw/firstname middlename lastname generation/},'lastname');
$id = $info{'id'};
}
$userinfo->{$uname.':'.$udom} = {
fullname => $fullname,
id => $id,
};
return;
}
sub process_date_info {
my ($userdata) = @_;
my $now = time;
$userdata->{'status'} = 'Active';
if ($userdata->{'start'} > 0) {
if ($now < $userdata->{'start'}) {
$userdata->{'status'} = 'Future';
}
}
if ($userdata->{'end'} > 0) {
if ($now > $userdata->{'end'}) {
$userdata->{'status'} = 'Expired';
}
}
return;
}
sub show_users_list {
my ($r,$context,$mode,$linkto,$statusmode,$userlist,$keylist)=@_;
#
# Variables for excel output
my ($excel_workbook, $excel_sheet, $excel_filename,$row,$format);
#
# Variables for csv output
my ($CSVfile,$CSVfilename);
#
my $sortby = $env{'form.sortby'};
if ($context eq 'course') {
if ($sortby !~ /^(username|domain|section|groups|fullname|id|start|end|type)$/) {
$sortby = 'username';
}
} else {
if ($sortby !~ /^(username|domain|id|fullname|start|end|role|email|extent)$/) {
$sortby = 'username';
}
}
my ($cid,$cdom,$cnum,$classgroups,$displayphotos,$displayclickers);
if ($context eq 'course') {
$cid=$env{'request.course.id'};
$cdom = $env{'course.'.$cid.'.domain'};
$cnum = $env{'course.'.$cid.'.num'};
($classgroups) = &Apache::loncoursedata::get_group_memberships(
$userlist,$keylist,$cdom,$cnum);
if (! exists($env{'form.displayphotos'})) {
$env{'form.displayphotos'} = 'off';
}
$displayphotos = $env{'form.displayphotos'};
if (! exists($env{'form.displayclickers'})) {
$env{'form.displayclickers'} = 'off';
}
$displayclickers = $env{'form.displayclickers'};
if ($env{'course.'.$cid.'.internal.showphoto'}) {
$r->print('
');
}
$r->print(<
END
}
unless ($mode eq 'autoenroll') {
$r->print(<
END
}
$r->print(<
END
my %lt=&Apache::lonlocal::texthash(
'username' => "username",
'domain' => "domain",
'id' => 'ID',
'fullname' => "name",
'section' => "section",
'groups' => "active groups",
'start' => "start date",
'end' => "end date",
'status' => "status",
'role' => "role",
'type' => "enroll type/action",
'email' => "email address",
'clicker' => "clicker id",
'photo' => "photo",
'extent' => "extent",
);
if ($context eq 'domain' && $env{'form.roletype'} eq 'course') {
$lt{'extent'} = &mt('Course(s): description, section(s), status');
} elsif ($context eq 'construction_space') {
$lt{'extent'} = &mt('Author');
}
my @cols = ('username','domain','id','fullname');
if ($context eq 'course') {
push(@cols,'section');
}
if (!($context eq 'domain' && $env{'form.roletype'} eq 'course')) {
push(@cols,('start','end'));
}
if ($env{'form.showrole'} eq 'Any') {
push(@cols,'role');
}
if ($context eq 'domain' && ($env{'form.roletype'} eq 'construction_space' ||
$env{'form.roletype'} eq 'course')) {
push (@cols,'extent');
}
if (($statusmode eq 'Any') &&
(!($context eq 'domain' && $env{'form.roletype'} eq 'course'))) {
push(@cols,'status');
}
if ($context eq 'course') {
push(@cols,'groups');
}
push(@cols,'email');
my $rolefilter;
if ($env{'form.showrole'} ne 'Any') {
$rolefilter = &Apache::lonnet::plaintext($env{'form.showrole'});
}
my $results_description = &results_header_row($rolefilter,$statusmode,
$context);
if ($mode eq 'html' || $mode eq 'view') {
$r->print(''.&mt('Searching').' ...
');
$r->rflush();
$r->print(''.$results_description.' ');
if ($linkto eq 'aboutme') {
$r->print(&mt("Select a user name to view the user's personal page."));
} elsif ($linkto eq 'modify') {
$r->print(&mt("Select a user name to modify the user's information"));
}
$r->print(<
END
$r->print("\n
\n".
&Apache::loncommon::start_data_table().
&Apache::loncommon::start_data_table_header_row());
if ($mode eq 'autoenroll') {
$r->print("
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 .= "
".&mt('Upload a file containing information about users')."
\n");
}
my %counts = (
user => 0,
auth => 0,
role => 0,
);
my $flushc=0;
my %student=();
my %curr_groups;
my %userchg;
if ($context eq 'course') {
# Get information about course groups
%curr_groups = &Apache::longroup::coursegroups();
}
# Get new users list
foreach (@userdata) {
my %entries=&Apache::loncommon::record_sep($_);
# 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).
'');
} else {
my $username = $entries{$fields{'username'}};
my $sec;
if ($context eq 'course' || $setting eq 'course') {
# determine section number
if (defined($fields{'sec'})) {
if (defined($entries{$fields{'sec'}})) {
$sec=$entries{$fields{'sec'}};
}
} else {
$sec = $defaultsec;
}
# remove non alphanumeric values from section
$sec =~ s/\W//g;
if ($sec eq "none" || $sec eq 'all') {
$r->print(' '.
&mt('[_1]: Unable to enroll: section name "[_2]" for user [_3] [_4] [_5] [_6] is a reserved word.',
$username,$sec,$fname,$mname,$lname,$gen));
next;
} elsif (($sec ne '') && (exists($curr_groups{$sec}))) {
$r->print(' '.
&mt('[_1]: Unable to enroll: section name "[_2]" for user [_3] [_4] [_5] [_6] is a course group. Section names and group names must be distinct.',
$username,$sec,$fname,$mname,$lname,$gen));
next;
}
}
# 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'}}) {
my @poss_roles =
&curr_role_permissions($context,$setting);
if (grep(/^\Q$entries{$fields{'role'}}\E/,@poss_roles)) {
$role=$entries{$fields{'role'}};
} else {
my $rolestr = join(', ',@poss_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,\$sec,\$role) {
$$_ =~ s/(\s+$|^\s+)//g;
}
if ($password || $env{'form.login'} eq 'loc') {
my ($userresult,$authresult,$roleresult);
if ($role eq 'st') {
&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);
} else {
($userresult,$authresult,$roleresult) =
&modifyuserrole($context,$setting,
$changeauth,$cid,$domain,$username,
$id,$amode,$password,$fname,
$mname,$lname,$gen,$sec,
$env{'form.forceid'},$desiredhost,
$email,$role,$enddate,$startdate);
}
$flushc =
&user_change_result($r,$userresult,$authresult,
$roleresult,\%counts,$flushc,
$username,%userchg);
} else {
if ($context eq 'course') {
$r->print(' '.
&mt('[_1]: Unable to enroll. No password specified.',$username)
);
} elsif ($context eq 'construction_space') {
$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
if ($context eq 'course' || ($context eq 'domain' && $setting eq 'course')) {
&Apache::lonnet::flushcourselogs();
}
$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('');
#####################################
# Drop students #
#####################################
if ($env{'form.fullup'} eq 'yes') {
$r->print('
'.&mt('Dropping Students')."
\n");
# Get current classlist
my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist();
if (! defined($classlist)) {
$r->print(&mt('There are no students currently enrolled.').
"\n");
} else {
# Remove the students we just added from the list of students.
foreach (@userdata) {
my %entries=&Apache::loncommon::record_sep($_);
unless (($entries{$fields{'username'}} eq '') ||
(!defined($entries{$fields{'username'}}))) {
delete($classlist->{$entries{$fields{'username'}}.
':'.$domain});
}
}
# Print out list of dropped students.
&show_drop_list($r,$classlist,$keylist,'nosort');
}
}
} # end of unless
}
sub user_change_result {
my ($r,$userresult,$authresult,$roleresult,$counts,$flushc,$username,
$userchg) = @_;
my $okresult = 0;
if ($userresult ne 'ok') {
if ($userresult =~ /^error:(.+)$/) {
my $error = $1;
$r->print(' '.
&mt('[_1]: Unable to add/modify: [_2]',$username,$error));
}
} else {
$counts->{'user'} ++;
$okresult = 1;
}
if ($authresult ne 'ok') {
if ($authresult =~ /^error:(.+)$/) {
my $error = $1;
$r->print(' '.
&mt('[_1]: Unable to modify authentication: [_2]',$username,$error));
}
} else {
$counts->{'auth'} ++;
$okresult = 1;
}
if ($roleresult ne 'ok') {
if ($roleresult =~ /^error:(.+)$/) {
my $error = $1;
$r->print(' '.
&mt('[_1]: Unable to add role: [_2]',$username,$error));
}
} else {
$counts->{'role'} ++;
$okresult = 1;
}
if ($okresult) {
$flushc++;
$userchg->{$username}=1;
$r->print('. ');
if ($flushc>15) {
$r->rflush;
$flushc=0;
}
}
return $flushc;
}
# ========================================================= Menu Phase Two Drop
sub print_expire_menu {
my ($r,$context) = @_;
$r->print("
".&mt("Expire Users' Roles")."
");
my $cid=$env{'request.course.id'};
my ($classlist,$keylist) = &Apache::loncoursedata::get_classlist();
if (! defined($classlist)) {
$r->print(&mt('There are no students currently enrolled.')."\n");
return;
}
# Print out the available choices
&show_drop_list($r,$classlist,$keylist);
return;
}
# ================================================================== Phase four
sub expire_user_list {
my ($r,$context) = @_;
my $count=0;
my @droplist = &Apache::loncommon::get_env_multiple('form.droplist');
foreach (@droplist) {
my ($uname,$udom)=split(/\:/,$_);
# drop student
my $result = &modifystudent($udom,$uname,$env{'request.course.id'});
if ($result eq 'ok' || $result eq 'ok:') {
$r->print(&mt('Dropped [_1]',$uname.'@'.$udom).' ');
$count++;
} else {
$r->print(
&mt('Error dropping [_1]:[_2]',$uname.'@'.$udom,$result).
' ');
}
}
$r->print('
'.&mt('Dropped [_1] user(s).',$count).'
');
$r->print('
'.&mt('Re-enrollment will re-activate data.')) if ($count);
}
sub section_check_js {
my $groupslist;
my %curr_groups = &Apache::longroup::coursegroups();
if (%curr_groups) {
$groupslist = join('","',sort(keys(%curr_groups)));
}
return <<"END";
function validate(caller) {
var groups = new Array("$groupslist");
var secname = caller.value;
if ((secname == 'all') || (secname == 'none')) {
alert("'"+secname+"' may not be used as the name for a section, as it is a reserved word.\\nPlease choose a different section name.");
return 'error';
}
if (secname != '') {
for (var k=0; k'.$authformkrb.''.
&Apache::loncommon::end_data_table_row()."\n";
}
if ($can_assign{'int'}) {
$response .= &Apache::loncommon::start_data_table_row().
'
'.$authformint.'
'.
&Apache::loncommon::end_data_table_row()."\n"
}
if ($can_assign{'loc'}) {
$response .= &Apache::loncommon::start_data_table_row().
'