# The LearningOnline Network with CAPA # Create a user # # $Id: loncreateuser.pm,v 1.184 2007/09/12 23:26:25 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 - handler to create users and custom roles =head1 SYNOPSIS Apache::loncreateuser 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. Creating custom roles can be done by the Domain Coordinator through the Create User functionality. That screen will show all privileges that can be assigned to users. For a complete list of privileges, please see C. Custom role definitions are stored in the C file of the role author. =cut use strict; use Apache::Constants qw(:common :http); use Apache::lonnet; use Apache::loncommon; use Apache::lonlocal; use Apache::longroup; use LONCAPA qw(:DEFAULT :match); my $loginscript; # piece of javascript used in two separate instances my $generalrule; my $authformnop; my $authformkrb; my $authformint; my $authformfsys; my $authformloc; sub initialize_authen_forms { my ($krbdefdom)=( $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/); $krbdefdom= uc($krbdefdom); my %param = ( formname => 'document.cu', kerb_def_dom => $krbdefdom ); # no longer static due to configurable kerberos defaults # $loginscript = &Apache::loncommon::authform_header(%param); $generalrule = &Apache::loncommon::authform_authorwarning(%param); $authformnop = &Apache::loncommon::authform_nochange(%param); # no longer static due to configurable kerberos defaults # $authformkrb = &Apache::loncommon::authform_kerberos(%param); $authformint = &Apache::loncommon::authform_internal(%param); $authformfsys = &Apache::loncommon::authform_filesystem(%param); $authformloc = &Apache::loncommon::authform_local(%param); } # ======================================================= 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; } # ==================================================== Figure out author access sub authorpriv { my ($auname,$audom)=@_; unless ((&Apache::lonnet::allowed('cca',$audom.'/'.$auname)) || (&Apache::lonnet::allowed('caa',$audom.'/'.$auname))) { return ''; } return 1; } # ==================================================== sub portfolio_quota { my ($ccuname,$ccdomain) = @_; my %lt = &Apache::lonlocal::texthash( 'disk' => "Disk space allocated to user's portfolio files", 'cuqu' => "Current quota", 'cust' => "Custom quota", 'defa' => "Default", 'chqu' => "Change quota", ); my ($currquota,$quotatype,$inststatus,$defquota) = &Apache::loncommon::get_user_quota($ccuname,$ccdomain); my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($ccdomain); my ($longinsttype,$showquota,$custom_on,$custom_off,$defaultinfo); if ($inststatus ne '') { if ($usertypes->{$inststatus} ne '') { $longinsttype = $usertypes->{$inststatus}; } } $custom_on = ' '; $custom_off = ' checked="checked" '; my $quota_javascript = <<"END_SCRIPT"; END_SCRIPT 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); } } my $output = $quota_javascript. '

'.$lt{'disk'}.'

'. $lt{'cuqu'}.': '.$currquota.' Mb.  '. $defaultinfo.'
'.$lt{'chqu'}. ':  '. '  '. ' Mb'; return $output; } # =================================================================== Phase one sub print_username_entry_form { my ($r,$response,$srch,$forcenewuser) = @_; my $defdom=$env{'request.role.domain'}; my $formtoset = 'crtuser'; if (exists($env{'form.startrolename'})) { $formtoset = 'docustom'; $env{'form.rolename'} = $env{'form.startrolename'}; } my ($jsback,$elements) = &crumb_utilities(); my $jscript = &Apache::loncommon::studentbrowser_javascript()."\n". ''."\n"; my %loaditems = ( 'onload' => "javascript:setFormElements(document.$formtoset)", ); my $start_page = &Apache::loncommon::start_page('Create Users, Change User Privileges', $jscript,{'add_entries' => \%loaditems,}); &Apache::lonhtmlcommon::add_breadcrumb ({href=>"javascript:backPage(document.crtuser)", text=>"User modify/custom role edit", faq=>282,bug=>'Instructor Interface',}); my $crumbs = &Apache::lonhtmlcommon::breadcrumbs('User Management'); my %existingroles=&my_custom_roles(); my $choice=&Apache::loncommon::select_form('make new role','rolename', ('make new role' => 'Generate new role ...',%existingroles)); my %lt=&Apache::lonlocal::texthash( 'srch' => "User Search", or => "or", 'siur' => "Set Individual User Roles", 'usr' => "Username", 'dom' => "Domain", 'ecrp' => "Edit Custom Role Privileges", 'nr' => "Name of Role", 'cre' => "Custom Role Editor", 'mod' => "to add/modify roles", ); my $help = &Apache::loncommon::help_open_menu(undef,undef,282,'Instructor Interface'); my $helpsiur=&Apache::loncommon::help_open_topic('Course_Change_Privileges'); my $helpecpr=&Apache::loncommon::help_open_topic('Course_Editing_Custom_Roles'); my $sellink=&Apache::loncommon::selectstudent_link('crtuser','srchterm','srchdomain'); if ($sellink) { $sellink = "$lt{'or'} ".$sellink; } $r->print(" $start_page $crumbs

$lt{siur}$helpsiur

$lt{'srch'} $sellink $lt{'mod'}

$response"); $r->print(&entry_form($defdom,$srch,$forcenewuser)); if (&Apache::lonnet::allowed('mcr','/')) { $r->print(<

$lt{'ecrp'}$helpecpr

$lt{'nr'}: $choice
ENDCUSTOM } $r->print(&Apache::loncommon::end_page()); } sub entry_form { my ($dom,$srch,$forcenewuser) = @_; my $userpicker = &Apache::loncommon::user_picker($dom,$srch,$forcenewuser, 'document.crtuser'); my $srchbutton = &mt('Search'); my $output = <<"ENDDOCUMENT";
$userpicker
ENDDOCUMENT return $output; } sub user_modification_js { my ($pjump_def,$dc_setcourse_code,$nondc_setsection_code,$groupslist)=@_; return < function pclose() { parmwin=window.open("/adm/rat/empty.html","LONCAPAparms", "height=350,width=350,scrollbars=no,menubar=no"); parmwin.close(); } $pjump_def $dc_setcourse_code function dateset() { eval("document.cu."+document.cu.pres_marker.value+ ".value=document.cu.pres_value.value"); pclose(); } $nondc_setsection_code END } # =================================================================== Phase two sub print_user_selection_page { my ($r,$response,$srch,$srch_results,$context,$srcharray) = @_; my @fields = ('username','domain','lastname','firstname','permanentemail'); my $sortby = $env{'form.sortby'}; if (!grep(/^\Q$sortby\E$/,@fields)) { $sortby = 'lastname'; } my ($jsback,$elements) = &crumb_utilities(); my $jscript = (< function pickuser(uname,udom) { document.usersrchform.seluname.value=uname; document.usersrchform.seludom.value=udom; document.usersrchform.phase.value="userpicked"; document.usersrchform.submit(); } $jsback ENDSCRIPT my %lt=&Apache::lonlocal::texthash( 'usrch' => "User Search to add/modify roles", 'stusrch' => "User Search to enroll student", 'usel' => "Select a user to add/modify roles", 'stusel' => "Select a user to enroll as a student", 'username' => "username", 'domain' => "domain", 'lastname' => "last name", 'firstname' => "first name", 'permanentemail' => "permanent e-mail", ); if ($context eq 'createuser') { $r->print(&Apache::loncommon::start_page('Create Users, Change User Privileges',$jscript)); &Apache::lonhtmlcommon::add_breadcrumb ({href=>"javascript:backPage(document.usersrchform,'','')", text=>"User modify/custom role edit", faq=>282,bug=>'Instructor Interface',}, {href=>"javascript:backPage(document.usersrchform,'get_user_info','select')", text=>"Select User", faq=>282,bug=>'Instructor Interface',}); $r->print(&Apache::lonhtmlcommon::breadcrumbs('User Management')); $r->print("$lt{'usrch'}
"); $r->print(&entry_form($srch->{'srchdomain'},$srch)); $r->print('

'.$lt{'usel'}.'

'); } else { $r->print($jscript."$lt{'stusrch'}
"); $r->print(&Apache::londropadd::single_user_entry_form($srch->{'srchdomain'},$srch)); $r->print('

'.$lt{'stusel'}.'

'); } $r->print('
'. &Apache::loncommon::start_data_table()."\n". &Apache::loncommon::start_data_table_header_row()."\n". ' '."\n"); foreach my $field (@fields) { $r->print(' '. $lt{$field}.''."\n"); } $r->print(&Apache::loncommon::end_data_table_header_row()); my @sorted_users = sort { lc($srch_results->{$a}->{$sortby}) cmp lc($srch_results->{$b}->{$sortby}) || lc($srch_results->{$a}->{lastname}) cmp lc($srch_results->{$b}->{lastname}) || lc($srch_results->{$a}->{firstname}) cmp lc($srch_results->{$b}->{firstname}) || lc($a) cmp lc($b) } (keys(%$srch_results)); foreach my $user (@sorted_users) { my ($uname,$udom) = split(/:/,$user); $r->print(&Apache::loncommon::start_data_table_row(). ''. ''.$uname.''. ''.$udom.''); foreach my $field ('lastname','firstname','permanentemail') { $r->print(''.$srch_results->{$user}->{$field}.''); } $r->print(&Apache::loncommon::end_data_table_row()); } $r->print(&Apache::loncommon::end_data_table().'

'); if (ref($srcharray) eq 'ARRAY') { foreach my $item (@{$srcharray}) { $r->print(''."\n"); } } $r->print(' '."\n". ' '."\n". ' '."\n". ' '."\n". ' '."\n"); $r->print($response); if ($context eq 'createuser') { $r->print('
'.&Apache::loncommon::end_page()); } else { $r->print(''."\n". ''."\n"); } } sub print_user_query_page { my ($r,$caller) = @_; # FIXME - this is for a network-wide name search (similar to catalog search) # To use frames with similar behavior to catalog/portfolio search. # To be implemented. return; } sub print_user_modification_page { my ($r,$ccuname,$ccdomain,$srch,$response) = @_; unless (($ccuname) && ($ccdomain)) { &print_username_entry_form($r); return; } if ($response) { $response = '
'.$response } my $defdom=$env{'request.role.domain'}; my ($krbdef,$krbdefdom) = &Apache::loncommon::get_kerberos_defaults($defdom); my %param = ( formname => 'document.cu', kerb_def_dom => $krbdefdom, kerb_def_auth => $krbdef ); $loginscript = &Apache::loncommon::authform_header(%param); $authformkrb = &Apache::loncommon::authform_kerberos(%param); my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition(); my $dc_setcourse_code = ''; my $nondc_setsection_code = ''; my %loaditem; my $groupslist; my %curr_groups = &Apache::longroup::coursegroups(); if (%curr_groups) { $groupslist = join('","',sort(keys(%curr_groups))); $groupslist = '"'.$groupslist.'"'; } if ($env{'request.role'} =~ m-^dc\./($match_domain)/$-) { my $dcdom = $1; $loaditem{'onload'} = "document.cu.coursedesc.value='';"; my @rolevals = ('st','ta','ep','in','cc'); my (@crsroles,@grproles); for (my $i=0; $i<@rolevals; $i++) { $crsroles[$i]=&Apache::lonnet::plaintext($rolevals[$i],'Course'); $grproles[$i]=&Apache::lonnet::plaintext($rolevals[$i],'Group'); } my $rolevalslist = join('","',@rolevals); my $crsrolenameslist = join('","',@crsroles); my $grprolenameslist = join('","',@grproles); my $pickcrsfirst = '<--'.&mt('Pick course first'); my $pickgrpfirst = '<--'.&mt('Pick group first'); $dc_setcourse_code = <<"ENDSCRIPT"; function setCourse() { var course = document.cu.dccourse.value; if (course != "") { if (document.cu.dcdomain.value != document.cu.origdom.value) { alert("You must select a course in the current domain"); return; } var userrole = document.cu.role.options[document.cu.role.selectedIndex].value var section=""; var numsections = 0; var newsecs = new Array(); for (var i=0; i 1)) { alert("In each course, each user may only have one student role at a time. You had selected "+numsections+" sections.\\nPlease modify your selections so they include no more than one section.") return; } for (var j=0; j 0)) { alert("Section designations do not apply to Course Coordinator roles.\\nA course coordinator role will be added with access to all sections."); section = ""; } var coursename = "_$dcdom"+"_"+course+"_"+userrole var numcourse = getIndex(document.cu.dccourse); if (numcourse == "-1") { alert("There was a problem with your course selection"); return } else { document.cu.elements[numcourse].name = "act"+coursename; var numnewsec = getIndex(document.cu.newsec); if (numnewsec != "-1") { document.cu.elements[numnewsec].name = "sec"+coursename; document.cu.elements[numnewsec].value = section; } var numstart = getIndex(document.cu.start); if (numstart != "-1") { document.cu.elements[numstart].name = "start"+coursename; } var numend = getIndex(document.cu.end); if (numend != "-1") { document.cu.elements[numend].name = "end"+coursename } } } document.cu.submit(); } function getIndex(caller) { for (var i=0;i 0) { if (document.cu.elements[i+1].value != "" && document.cu.elements[i+1].value != null) { sections = sections + "," + document.cu.elements[i+1].value; } } else { sections = document.cu.elements[i+1].value; } var newsecs = document.cu.elements[i+1].value; var numsplit; if (newsecs != null && newsecs != "") { numsplit = newsecs.split(/,/g); numsec = numsec + numsplit.length; } if ((role == 'st') && (numsec > 1)) { alert("In each course, each user may only have one student role at a time. You had selected "+numsec+" sections.\\nPlease modify your selections so they include no more than one section.") return; } else if (numsplit != null) { for (var j=0; j'."\n".$jsback."\n".''; my $start_page = &Apache::loncommon::start_page('Create Users, Change User Privileges', $js,{'add_entries' => \%loaditem,}); &Apache::lonhtmlcommon::add_breadcrumb ({href=>"javascript:backPage(document.cu)", text=>"User modify/custom role edit", faq=>282,bug=>'Instructor Interface',}); if ($env{'form.phase'} eq 'userpicked') { &Apache::lonhtmlcommon::add_breadcrumb ({href=>"javascript:backPage(document.cu,'get_user_info','select')", text=>"Select a user", faq=>282,bug=>'Instructor Interface',}); } &Apache::lonhtmlcommon::add_breadcrumb ({href=>"javascript:backPage(document.cu,'$env{'form.phase'}','modify')", text=>"Set user role", faq=>282,bug=>'Instructor Interface',}); my $crumbs = &Apache::lonhtmlcommon::breadcrumbs('User Management'); my $forminfo =<<"ENDFORMINFO";
ENDFORMINFO my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain); my %inccourses; foreach my $key (keys(%env)) { if ($key=~/^user\.priv\.cm\.\/($match_domain)\/($match_username)/) { $inccourses{$1.'_'.$2}=1; } } if ($uhome eq 'no_host') { my $newuser; my $instsrch = { srchin => 'instd', srchby => 'uname', srchtype => 'exact', }; if ($env{'form.phase'} eq 'userpicked') { $instsrch->{'srchterm'} = $env{'form.seluname'}; $instsrch->{'srchdomain'} = $env{'form.seludom'}; } else { $instsrch->{'srchterm'} = $ccuname; $instsrch->{'srchdomain'} = $ccdomain, } if (($instsrch->{'srchterm'} ne '') && ($instsrch->{'srchdomain'} ne '')) { $newuser = $instsrch->{'srchterm'}.':'.$instsrch->{'srchdomain'}; } my (%dirsrch_results,%inst_results,$dirsrchres); if ($newuser) { if (&directorysrch_check($instsrch) eq 'ok') { ($dirsrchres,%dirsrch_results) = &Apache::lonnet::inst_directory_query($instsrch); if ($dirsrchres eq 'ok') { if (ref($dirsrch_results{$newuser}) eq 'HASH') { %inst_results = %{$dirsrch_results{$newuser}}; } } } } my $home_server_list= ''."\n". &Apache::loncommon::home_server_option_list($ccdomain); my %lt=&Apache::lonlocal::texthash( 'cnu' => "Create New User", 'nu' => "New User", 'id' => "in domain", 'pd' => "Personal Data", 'fn' => "First Name", 'mn' => "Middle Name", 'ln' => "Last Name", 'gen' => "Generation", 'mail' => "Permanent e-mail address", 'idsn' => "ID/Student Number", 'hs' => "Home Server", 'lg' => "Login Data" ); my $portfolioform; if (&Apache::lonnet::allowed('mpq',$env{'request.role.domain'})) { # Current user has quota modification privileges $portfolioform = &portfolio_quota($ccuname,$ccdomain); } my $genhelp=&Apache::loncommon::help_open_topic('Generation'); &initialize_authen_forms(); $r->print(<$lt{'cnu'} $response $forminfo

$lt{'nu'} "$ccuname" $lt{'id'} $ccdomain

$lt{'pd'}

$lt{'fn'}
$lt{'mn'}
$lt{'ln'}
$lt{'gen'}$genhelp
$lt{'mail'}
$lt{'idsn'}

$lt{'hs'}:

$lt{'lg'}

$generalrule

$authformkrb

$authformint

$authformfsys

$authformloc


$portfolioform ENDNEWUSER } else { # user already exists my %lt=&Apache::lonlocal::texthash( 'cup' => "Change User Privileges", 'usr' => "User", 'id' => "in domain", 'fn' => "first name", 'mn' => "middle name", 'ln' => "last name", 'gen' => "generation", 'email' => "permanent e-mail", ); $r->print(<$lt{'cup'} $forminfo

$lt{'usr'} "$ccuname" $lt{'id'} "$ccdomain"

ENDCHANGEUSER # Get the users information my %userenv = &Apache::lonnet::get('environment', ['firstname','middlename','lastname','generation', 'permanentemail','portfolioquota'],$ccdomain,$ccuname); my %rolesdump=&Apache::lonnet::dump('roles',$ccdomain,$ccuname); $r->print('
'. &Apache::loncommon::start_data_table(). &Apache::loncommon::start_data_table_header_row(). ''.$lt{'fn'}.''.$lt{'mn'}.''.$lt{'ln'}.''.$lt{'gen'}.''.$lt{'email'}.''. &Apache::loncommon::end_data_table_header_row(). &Apache::loncommon::start_data_table_row()); foreach my $item ('firstname','middlename','lastname','generation','permanentemail') { if (&Apache::lonnet::allowed('mau',$ccdomain)) { $r->print(<<"END"); END } else { $r->print(''.$userenv{$item}.''); } } $r->print(&Apache::loncommon::end_data_table_row(). &Apache::loncommon::end_data_table()); # Build up table of user roles to allow revocation of a role. my ($tmp) = keys(%rolesdump); unless ($tmp =~ /^(con_lost|error)/i) { my $now=time; my %lt=&Apache::lonlocal::texthash( 'rer' => "Revoke Existing Roles", 'rev' => "Revoke", 'del' => "Delete", 'ren' => "Re-Enable", 'rol' => "Role", 'ext' => "Extent", 'sta' => "Start", 'end' => "End" ); my (%roletext,%sortrole,%roleclass,%rolepriv); 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); # 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'; if ($area =~ m{^/($match_domain)/($match_courseid)} ) { $class='Course'; my ($coursedom,$coursedir) = ($1,$2); $sortkey.="\0$coursedom"; # $1.'_'.$2 is the course id (eg. 103_12345abcef103l3). my %coursedata= &Apache::lonnet::coursedescription($1.'_'.$2); my $carea; if (defined($coursedata{'description'})) { $carea=$coursedata{'description'}. '
'.&mt('Domain').': '.$coursedom.(' 'x8). &Apache::loncommon::syllabuswrapper('Syllabus',$coursedir,$coursedom); $sortkey.="\0".$coursedata{'description'}; $class=$coursedata{'type'}; } else { $carea=&mt('Unavailable course').': '.$area; $sortkey.="\0".&mt('Unavailable course').': '.$area; } $sortkey.="\0$coursedir"; $inccourses{$1.'_'.$2}=1; if ((&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) || (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) { $allowed=1; } if ((&Apache::lonnet::allowed('dro',$1)) || (&Apache::lonnet::allowed('dro',$ccdomain))) { $delallowed=1; } # - custom role. Needs more info, too if ($croletitle) { if (&Apache::lonnet::allowed('ccr',$1.'/'.$2)) { $allowed=1; $thisrole.='.'.$role_code; } } # Compute the background color based on $area if ($area=~m{^/($match_domain)/($match_courseid)/(\w+)}) { $carea.='
Section: '.$3; $sortkey.="\0$3"; } $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') { $class='Construction 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 (&authorpriv($2,$1)) { $allowed=1; } else { $allowed=0; } } my $row = ''; $row.= ''; my $active=1; $active=0 if (($role_end_time) && ($now>$role_end_time)); 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.=' '; } my $plaintext=''; if (!$croletitle) { $plaintext=&Apache::lonnet::plaintext($role_code,$class) } else { $plaintext= "Customrole '$croletitle' defined by $croleuname\@$croleudom"; } $row.= ''.$plaintext. ''.$area. ''.($role_start_time?localtime($role_start_time) : ' ' ). ''.($role_end_time ?localtime($role_end_time) : ' ' ) .""; $sortrole{$sortkey}=$envkey; $roletext{$envkey}=$row; $roleclass{$envkey}=$class; $rolepriv{$envkey}=$allowed; #$r->print($row); } # end of foreach (table building loop) my $rolesdisplay = 0; my %output = (); foreach my $type ('Construction Space','Course','Group','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} = ''. "".&mt($type)."". $output{$type}; $rolesdisplay = 1; } } if ($rolesdisplay == 1) { $r->print('

'.$lt{'rer'}.'

'. &Apache::loncommon::start_data_table("LC_createuser"). &Apache::loncommon::start_data_table_header_row(). ''.$lt{'rev'}.''.$lt{'ren'}.''.$lt{'del'}. ''.$lt{'rol'}.''.$lt{'ext'}. ''.$lt{'sta'}.''.$lt{'end'}.''. &Apache::loncommon::end_data_table_header_row()); foreach my $type ('Construction Space','Course','Group','Domain','System','Unknown') { if ($output{$type}) { $r->print($output{$type}."\n"); } } $r->print(&Apache::loncommon::end_data_table()); } } # End of unless my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain); if ($currentauth=~/^krb(4|5):/) { $currentauth=~/^krb(4|5):(.*)/; my $krbdefdom=$2; my %param = ( formname => 'document.cu', kerb_def_dom => $krbdefdom ); $loginscript = &Apache::loncommon::authform_header(%param); } # Check for a bad authentication type unless ($currentauth=~/^krb(4|5):/ or $currentauth=~/^unix:/ or $currentauth=~/^internal:/ or $currentauth=~/^localauth:/ ) { # bad authentication scheme if (&Apache::lonnet::allowed('mau',$ccdomain)) { &initialize_authen_forms(); my %lt=&Apache::lonlocal::texthash( 'err' => "ERROR", 'uuas' => "This user has an unrecognized authentication scheme", 'sldb' => "Please specify login data below", 'ld' => "Login Data" ); $r->print(< $lt{'err'}: $lt{'uuas'} ($currentauth). $lt{'sldb'}.

$lt{'ld'}

$generalrule

$authformkrb

$authformint

$authformfsys

$authformloc

ENDBADAUTH } else { # This user is not allowed to modify the user's # authentication scheme, so just notify them of the problem my %lt=&Apache::lonlocal::texthash( 'err' => "ERROR", 'uuas' => "This user has an unrecognized authentication scheme", 'adcs' => "Please alert a domain coordinator of this situation" ); $r->print(< $lt{'err'}: $lt{'uuas'} ($currentauth). $lt{'adcs'}.
ENDBADAUTH } } else { # Authentication type is valid my $authformcurrent=''; my $authform_other=''; &initialize_authen_forms(); if ($currentauth=~/^krb(4|5):/) { $authformcurrent=$authformkrb; $authform_other="

$authformint

\n". "

$authformfsys

$authformloc

"; } elsif ($currentauth=~/^internal:/) { $authformcurrent=$authformint; $authform_other="

$authformkrb

". "

$authformfsys

$authformloc

"; } elsif ($currentauth=~/^unix:/) { $authformcurrent=$authformfsys; $authform_other="

$authformkrb

". "

$authformint

$authformloc;

"; } elsif ($currentauth=~/^localauth:/) { $authformcurrent=$authformloc; $authform_other="

$authformkrb

". "

$authformint

$authformfsys

"; } $authformcurrent.=' (will override current values)
'; if (&Apache::lonnet::allowed('mau',$ccdomain)) { # Current user has login modification privileges my %lt=&Apache::lonlocal::texthash( 'ccld' => "Change Current Login Data", 'enld' => "Enter New Login Data" ); $r->print(<

$lt{'ccld'}

$generalrule

$authformnop

$authformcurrent

$lt{'enld'}

$authform_other ENDOTHERAUTHS } else { if (&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", ); $r->print(<

$lt{'ccld'}

$lt{'yodo'} $lt{'ifch'}: $ccdomain ENDNOPRIV } } if (&Apache::lonnet::allowed('mpq',$env{'request.role.domain'})) { # Current user has quota modification privileges $r->print(&portfolio_quota($ccuname,$ccdomain)); } } ## End of "check for bad authentication type" logic } ## End of new user/old user logic $r->print('

'.&mt('Add Roles').'

'); # # Co-Author # if (&authorpriv($env{'user.name'},$env{'request.role.domain'}) && ($env{'user.name'} ne $ccuname || $env{'user.domain'} ne $ccdomain)) { # No sense in assigning co-author role to yourself my $cuname=$env{'user.name'}; my $cudom=$env{'request.role.domain'}; my %lt=&Apache::lonlocal::texthash( 'cs' => "Construction Space", 'act' => "Activate", 'rol' => "Role", 'ext' => "Extent", 'sta' => "Start", 'end' => "End", 'cau' => "Co-Author", 'caa' => "Assistant Co-Author", 'ssd' => "Set Start Date", 'sed' => "Set End Date" ); $r->print('

'.$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()."\n". ' '.$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()); } # # 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(); foreach my $thisdomain (sort(&Apache::lonnet::all_domains())) { foreach my $role ('dc','li','dg','au','sc') { 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); } # # Course and group levels # if ($env{'request.role'} =~ m{^dc\./($match_domain)/$}) { $r->print(&course_level_dc($1,'Course')); $r->print('
'."\n"); } else { $r->print(&course_level_table(%inccourses)); $r->print('
'."\n"); } $r->print(&Apache::lonhtmlcommon::echo_form_input(['phase','userrole','ccdomain','prevphase','currstate'])); $r->print(''); $r->print(''); $r->print("".&Apache::loncommon::end_page()); } # ================================================================= Phase Three sub update_user_data { my ($r) = @_; my $uhome=&Apache::lonnet::homeserver($env{'form.ccuname'}, $env{'form.ccdomain'}); # Error messages my $error = ''.&mt('Error').':'; my $end = &Apache::loncommon::end_page(); my $title; if (exists($env{'form.makeuser'})) { $title='Set Privileges for New User'; } else { $title='Modify User Privileges'; } my ($jsback,$elements) = &crumb_utilities(); my $jscript = ''."\n"; $r->print(&Apache::loncommon::start_page($title,$jscript)); &Apache::lonhtmlcommon::add_breadcrumb ({href=>"javascript:backPage(document.userupdate)", text=>"User modify/custom role edit", faq=>282,bug=>'Instructor Interface',}); if ($env{'form.prevphase'} eq 'userpicked') { &Apache::lonhtmlcommon::add_breadcrumb ({href=>"javascript:backPage(document.userupdate,'get_user_info','select')", text=>"Select a user", faq=>282,bug=>'Instructor Interface',}); } &Apache::lonhtmlcommon::add_breadcrumb ({href=>"javascript:backPage(document.userupdate,'$env{'form.prevphase'}','modify')", text=>"Set user role", faq=>282,bug=>'Instructor Interface',}, {href=>"/adm/createuser", text=>"Result", faq=>282,bug=>'Instructor Interface',}); $r->print(&Apache::lonhtmlcommon::breadcrumbs('User Management')); my %disallowed; # Check Inputs if (! $env{'form.ccuname'} ) { $r->print($error.&mt('No login name specified').'.'.$end); 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); return; } if (! $env{'form.ccdomain'} ) { $r->print($error.&mt('No domain specified').'.'.$end); 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); return; } 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('Unable to determine home server for '). $env{'form.ccuname'}.&mt(' in domain '). $env{'form.ccdomain'}.'.'); return; } } # Determine authentication method and password for the user being modified my $amode=''; my $genpwd=''; if ($env{'form.login'} eq 'krb') { $amode='krb'; $amode.=$env{'form.krbver'}; $genpwd=$env{'form.krbarg'}; } elsif ($env{'form.login'} eq 'int') { $amode='internal'; $genpwd=$env{'form.intarg'}; } elsif ($env{'form.login'} eq 'fsys') { $amode='unix'; $genpwd=$env{'form.fsysarg'}; } elsif ($env{'form.login'} eq 'loc') { $amode='localauth'; $genpwd=$env{'form.locarg'}; $genpwd=" " if (!$genpwd); } elsif (($env{'form.login'} eq 'nochange') || ($env{'form.login'} eq '' )) { # There is no need to tell the user we did not change what they # did not ask us to change. # If they are creating a new user but have not specified login # information this will be caught below. } else { $r->print($error.&mt('Invalid login mode or password').$end); return; } $r->print('

'.&mt('User [_1] in domain [_2]', $env{'form.ccuname'}, $env{'form.ccdomain'}).'

'); 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); 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')); return; } } # Call modifyuser my $result = &Apache::lonnet::modifyuser ($env{'form.ccdomain'},$env{'form.ccuname'},$env{'form.cstid'}, $amode,$genpwd,$env{'form.cfirst'}, $env{'form.cmiddle'},$env{'form.clast'},$env{'form.cgen'}, undef,$desiredhost,$env{'form.cemail'} ); $r->print(&mt('Generating user').': '.$result); my $home = &Apache::lonnet::homeserver($env{'form.ccuname'}, $env{'form.ccdomain'}); $r->print('
'.&mt('Home server').': '.$home.' '. &Apache::lonnet::hostname($home)); } 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); return; } # Only allow authentification 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 authentification information').'.'); } } ## if (! $env{'form.makeuser'} ) { # Check for need to change my %userenv = &Apache::lonnet::get ('environment',['firstname','middlename','lastname','generation', 'permanentemail','portfolioquota','inststatus'], $env{'form.ccdomain'},$env{'form.ccuname'}); my ($tmp) = keys(%userenv); if ($tmp =~ /^(con_lost|error)/i) { %userenv = (); } # Check to see if we need to change user information foreach my $item ('firstname','middlename','lastname','generation','permanentemail') { # Strip leading and trailing whitespace $env{'form.c'.$item} =~ s/(\s+$|^\s+)//g; } my ($quotachanged,$namechanged,$oldportfolioquota,$newportfolioquota, $inststatus,$isdefault,$defquotatext); my ($defquota,$settingstatus) = &Apache::loncommon::default_quota($env{'form.ccdomain'},$inststatus); my %changeHash; if ($userenv{'portfolioquota'} ne '') { $oldportfolioquota = $userenv{'portfolioquota'}; if ($env{'form.customquota'} == 1) { if ($env{'form.portfolioquota'} eq '') { $newportfolioquota = 0; } else { $newportfolioquota = $env{'form.portfolioquota'}; $newportfolioquota =~ s/[^\d\.]//g; } if ($newportfolioquota != $userenv{'portfolioquota'}) { $quotachanged = "a_admin($newportfolioquota,\%changeHash); } } else { $quotachanged = "a_admin('',\%changeHash); $newportfolioquota = $defquota; $isdefault = 1; } } else { $oldportfolioquota = $defquota; if ($env{'form.customquota'} == 1) { if ($env{'form.portfolioquota'} eq '') { $newportfolioquota = 0; } else { $newportfolioquota = $env{'form.portfolioquota'}; $newportfolioquota =~ s/[^\d\.]//g; } $quotachanged = "a_admin($newportfolioquota,\%changeHash); } else { $newportfolioquota = $defquota; $isdefault = 1; } } if ($isdefault) { if ($settingstatus eq '') { $defquotatext = &mt('(default)'); } else { my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($env{'form.ccdomain'}); if ($usertypes->{$settingstatus} eq '') { $defquotatext = &mt('(default)'); } else { $defquotatext = &mt('(default for [_1])',$usertypes->{$settingstatus}); } } } if (&Apache::lonnet::allowed('mau',$env{'form.ccdomain'}) && ($env{'form.cfirstname'} ne $userenv{'firstname'} || $env{'form.cmiddlename'} ne $userenv{'middlename'} || $env{'form.clastname'} ne $userenv{'lastname'} || $env{'form.cgeneration'} ne $userenv{'generation'} || $env{'form.cpermanentemail'} ne $userenv{'permanentemail'} )) { $namechanged = 1; } if ($namechanged) { # Make the change $changeHash{'firstname'} = $env{'form.cfirstname'}; $changeHash{'middlename'} = $env{'form.cmiddlename'}; $changeHash{'lastname'} = $env{'form.clastname'}; $changeHash{'generation'} = $env{'form.cgeneration'}; $changeHash{'permanentemail'} = $env{'form.cpermanentemail'}; my $putresult = &Apache::lonnet::put ('environment',\%changeHash, $env{'form.ccdomain'},$env{'form.ccuname'}); if ($putresult eq 'ok') { # Tell the user we changed the name my %lt=&Apache::lonlocal::texthash( 'uic' => "User Information Changed", 'frst' => "first", 'mddl' => "middle", 'lst' => "last", 'gen' => "generation", 'mail' => "permanent e-mail", 'disk' => "disk space allocated to portfolio files", 'prvs' => "Previous", 'chto' => "Changed To" ); $r->print(<<"END");
$lt{'uic'}
  $lt{'frst'} $lt{'mddl'} $lt{'lst'} $lt{'gen'} $lt{'mail'} $lt{'disk'}
$lt{'prvs'} $userenv{'firstname'} $userenv{'middlename'} $userenv{'lastname'} $userenv{'generation'} $userenv{'permanentemail'} $oldportfolioquota Mb
$lt{'chto'} $env{'form.cfirstname'} $env{'form.cmiddlename'} $env{'form.clastname'} $env{'form.cgeneration'} $env{'form.cpermanentemail'} $newportfolioquota Mb $defquotatext
END 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("

".&mt('Unable to successfully change environment for')." ". $env{'form.ccuname'}." ".&mt('in domain')." ". $env{'form.ccdomain'}."

"); } } else { # End of if ($env ... ) logic my $putresult; if ($quotachanged) { $putresult = &Apache::lonnet::put ('environment',\%changeHash, $env{'form.ccdomain'},$env{'form.ccuname'}); } # They did not want to change the users name but we can # still tell them what the name is my %lt=&Apache::lonlocal::texthash( 'mail' => "Permanent e-mail", 'disk' => "Disk space allocated to user's portfolio files", ); $r->print(<<"END");

$userenv{'firstname'} $userenv{'middlename'} $userenv{'lastname'} $userenv{'generation'}

$lt{'mail'}: $userenv{'permanentemail'}

END if ($putresult eq 'ok') { if ($oldportfolioquota != $newportfolioquota) { $r->print('

'.$lt{'disk'}.': '.$newportfolioquota.' Mb '. $defquotatext.'

'); &Apache::lonnet::appenv('environment.portfolioquota' => $changeHash{'portfolioquota'}); } } } } ## my $now=time; $r->print('

'.&mt('Modifying Roles').'

'); foreach my $key (keys (%env)) { next if (! $env{$key}); # 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); $r->print(&mt('Revoking [_1] in [_2]: [_3]', $role,$scope,''.$result.'').'
'); if ($role eq 'st') { my $result = &classlist_drop($scope,$env{'form.ccuname'}, $env{'form.ccdomain'},$now); $r->print($result); } } if ($key=~m{^form\.rev\:([^_]+)_cr\.cr/($match_domain)/($match_username)/(\w+)$ }s) { # Revoke custom role $r->print(&mt('Revoking custom role:'). ' '.$4.' by '.$3.':'.$2.' in '.$1.': '. &Apache::lonnet::revokecustomrole($env{'form.ccdomain'}, $env{'form.ccuname'},$1,$2,$3,$4). '
'); } } 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); $r->print(&mt('Deleting [_1] in [_2]: [_3]',$role,$scope, ''.$result.'').'
'); if ($role eq 'st') { my $result = &classlist_drop($scope,$env{'form.ccuname'}, $env{'form.ccdomain'},$now); $r->print($result); } } if ($key=~m{^form\.del\:([^_]+)_cr\.cr/($match_domain)/($match_username)/(\w+)$}) { my ($url,$rdom,$rnam,$rolename) = ($1,$2,$3,$4); # Delete custom role $r->print(&mt('Deleting custom role [_1] by [_2]:[_3] in [_4]', $rolename,$rnam,$rdom,$url).': '. &Apache::lonnet::assigncustomrole($env{'form.ccdomain'}, $env{'form.ccuname'},$url,$rdom,$rnam,$rolename,$now, 0,1).'
'); } } 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 $result = &Apache::loncommon::commit_studentrole(\$logmsg,$udom,$uname,$url,$role,$now,0,$1,$2,$3); if (($result =~ /^error/) || ($result eq 'not_in_class') || ($result eq 'unknown_course')) { $output = "Error: $result\n"; } else { $output = &mt('Assigning').' '.$role.' in '.$url. &mt('starting').' '.localtime($now). ':
'.$logmsg.'
'. &mt('Add to classlist').': ok
'; } } } else { my $result=&Apache::lonnet::assignrole($env{'form.ccdomain'}, $env{'form.ccuname'},$url,$role,0,$now); $output = &mt('Re-enabling [_1] in [_2]: [_3]', $role,$url,$result).'
'; } $r->print($output); } # 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); $r->print(&mt('Re-enabling custom role [_1] by [_2]@[_3] in [_4] : [_5]', $rolename,$rnam,$rdom,$url,$result).'
'); } } 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)); } 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)); } } } 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); if ($num_sections == 0) { $r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$url,$three,$start,$end,$one,$two,'')); } 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)); } else { $emptysec = 1; } } if ($emptysec) { $r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$url,$three,$start,$end,$one,$two,'')); } } } 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 $url='/'.$1.'/'; # split multiple sections my %sections = (); my $num_sections = &build_roles($env{'form.sec_'.$1.'_'.$2},\%sections,$2); if ($num_sections == 0) { $r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$url,$2,$start,$end,$1,undef,'')); } 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,$2,$start,$end,$1,undef,$sec)); } else { $emptysec = 1; } } if ($emptysec) { $r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$url,$2,$start,$end,$1,undef,'')); } } } else { $r->print('

'.&mt('ERROR').': '.&mt('Unknown command').' '.$key.'


'); } foreach my $key (sort(keys(%disallowed))) { 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 go back and choose a different section name.').'


'); } } } # End of foreach (keys(%env)) # Flush the course logs so reverse user roles immediately updated &Apache::lonnet::flushcourselogs(); $r->print('

'.&mt('Create/Modify Another User').'

'); $r->print('
'."\n"); foreach my $item ('srchby','srchin','srchtype','srchterm','srchdomain','ccuname','ccdomain') { $r->print(''."\n"); } foreach my $item ('sortby','seluname','seludom') { if (exists($env{'form.'.$item})) { $r->print(''."\n"); } } $r->print(''."\n". ''."\n". '
'); $r->print(&Apache::loncommon::end_page()); } sub classlist_drop { my ($scope,$uname,$udom,$now) = @_; my ($cdom,$cnum) = ($scope=~m{^/($match_domain)/($match_courseid)}); my $cid=$cdom.'_'.$cnum; my $user = $uname.':'.$udom; 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.'').'
'; } } sub active_student_roles { my ($cnum,$cdom,$uname,$udom) = @_; my %roles = &Apache::lonnet::get_my_roles($uname,$udom,'userroles', ['future','active'],['st']); return exists($roles{"$cnum:$cdom:st"}); } sub quota_admin { my ($setquota,$changeHash) = @_; my $quotachanged; if (&Apache::lonnet::allowed('mpq',$env{'form.ccdomain'})) { # Current user has quota modification privileges $quotachanged = 1; $changeHash->{'portfolioquota'} = $setquota; } return $quotachanged; } sub build_roles { my ($sectionstr,$sections,$role) = @_; my $num_sections = 0; if ($sectionstr=~ /,/) { my @secnums = split/,/,$sectionstr; if ($role eq 'st') { $secnums[0] =~ s/\W//g; $$sections{$secnums[0]} = 1; $num_sections = 1; } else { foreach my $sec (@secnums) { $sec =~ ~s/\W//g; if (!($sec eq "")) { if (exists($$sections{$sec})) { $$sections{$sec} ++; } else { $$sections{$sec} = 1; $num_sections ++; } } } } } else { $sectionstr=~s/\W//g; unless ($sectionstr eq '') { $$sections{$sectionstr} = 1; $num_sections ++; } } return $num_sections; } # ========================================================== Custom Role Editor sub custom_role_editor { my ($r) = @_; my $rolename=$env{'form.rolename'}; if ($rolename eq 'make new role') { $rolename=$env{'form.newrolename'}; } $rolename=~s/[^A-Za-z0-9]//gs; if (!$rolename) { &print_username_entry_form($r); return; } # ------------------------------------------------------- What can be assigned? my %full=(); my %courselevel=(); my %courselevelcurrent=(); my $syspriv=''; my $dompriv=''; my $coursepriv=''; my $body_top; my ($disp_dummy,$disp_roles) = &Apache::lonnet::get('roles',["st"]); my ($rdummy,$roledef)= &Apache::lonnet::get('roles',["rolesdef_$rolename"]); # ------------------------------------------------------- Does this role exist? $body_top .= '

'; if (($rdummy ne 'con_lost') && ($roledef ne '')) { $body_top .= &mt('Existing Role').' "'; # ------------------------------------------------- Get current role privileges ($syspriv,$dompriv,$coursepriv)=split(/\_/,$roledef); } else { $body_top .= &mt('New Role').' "'; $roledef=''; } $body_top .= $rolename.'"

'; foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:c'})) { my ($priv,$restrict)=split(/\&/,$item); if (!$restrict) { $restrict='F'; } $courselevel{$priv}=$restrict; if ($coursepriv=~/\:$priv/) { $courselevelcurrent{$priv}=1; } $full{$priv}=1; } my %domainlevel=(); my %domainlevelcurrent=(); foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:d'})) { my ($priv,$restrict)=split(/\&/,$item); if (!$restrict) { $restrict='F'; } $domainlevel{$priv}=$restrict; if ($dompriv=~/\:$priv/) { $domainlevelcurrent{$priv}=1; } $full{$priv}=1; } my %systemlevel=(); my %systemlevelcurrent=(); foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:s'})) { my ($priv,$restrict)=split(/\&/,$item); if (!$restrict) { $restrict='F'; } $systemlevel{$priv}=$restrict; if ($syspriv=~/\:$priv/) { $systemlevelcurrent{$priv}=1; } $full{$priv}=1; } my ($jsback,$elements) = &crumb_utilities(); my $button_code = "\n"; my $head_script = "\n"; $head_script .= ''."\n"; $r->print(&Apache::loncommon::start_page('Custom Role Editor',$head_script)); &Apache::lonhtmlcommon::add_breadcrumb ({href=>"javascript:backPage(document.form1,'','')", text=>"User modify/custom role edit", faq=>282,bug=>'Instructor Interface',}, {href=>"javascript:backPage(document.form1,'','')", text=>"Edit custom role", faq=>282,bug=>'Instructor Interface',}); $r->print(&Apache::lonhtmlcommon::breadcrumbs('User Management')); $r->print($body_top); my %lt=&Apache::lonlocal::texthash( 'prv' => "Privilege", 'crl' => "Course Level", 'dml' => "Domain Level", 'ssl' => "System Level"); $r->print('Select a Template
'); $r->print('
'); $r->print($button_code); $r->print('
'); $r->print(< ENDCCF $r->print(&Apache::loncommon::start_data_table(). &Apache::loncommon::start_data_table_header_row(). ''.$lt{'prv'}.''.$lt{'crl'}.''.$lt{'dml'}. ''.$lt{'ssl'}.''. &Apache::loncommon::end_data_table_header_row()); foreach my $priv (sort keys %full) { my $privtext = &Apache::lonnet::plaintext($priv); $r->print(&Apache::loncommon::start_data_table_row(). ''.$privtext.''. ($courselevel{$priv}?'':' '). ''. ($domainlevel{$priv}?'':' '). ''. ($systemlevel{$priv}?'':' '). ''. &Apache::loncommon::end_data_table_row()); } $r->print(&Apache::loncommon::end_data_table(). ''."\n".''."\n". ''."\n". ''. &Apache::loncommon::end_page()); } # -------------------------------------------------------- sub make_script_template { my ($role) = @_; my %full_c=(); my %full_d=(); my %full_s=(); my $return_script; foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:c'})) { my ($priv,$restrict)=split(/\&/,$item); $full_c{$priv}=1; } foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:d'})) { my ($priv,$restrict)=split(/\&/,$item); $full_d{$priv}=1; } foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:s'})) { my ($priv,$restrict)=split(/\&/,$item); $full_s{$priv}=1; } $return_script .= 'function set_'.$role.'() {'."\n"; my @temp = split(/:/,$Apache::lonnet::pr{$role.':c'}); my %role_c; foreach my $priv (@temp) { my ($priv_item, $dummy) = split(/\&/,$priv); $role_c{$priv_item} = 1; } foreach my $priv_item (keys(%full_c)) { my ($priv, $dummy) = split(/\&/,$priv_item); if (exists($role_c{$priv})) { $return_script .= "document.form1.$priv"."_c.checked = true;\n"; } else { $return_script .= "document.form1.$priv"."_c.checked = false;\n"; } } my %role_d; @temp = split(/:/,$Apache::lonnet::pr{$role.':d'}); foreach my $priv(@temp) { my ($priv_item, $dummy) = split(/\&/,$priv); $role_d{$priv_item} = 1; } foreach my $priv_item (keys(%full_d)) { my ($priv, $dummy) = split(/\&/,$priv_item); if (exists($role_d{$priv})) { $return_script .= "document.form1.$priv"."_d.checked = true;\n"; } else { $return_script .= "document.form1.$priv"."_d.checked = false;\n"; } } my %role_s; @temp = split(/:/,$Apache::lonnet::pr{$role.':s'}); foreach my $priv(@temp) { my ($priv_item, $dummy) = split(/\&/,$priv); $role_s{$priv_item} = 1; } foreach my $priv_item (keys(%full_s)) { my ($priv, $dummy) = split(/\&/,$priv_item); if (exists($role_s{$priv})) { $return_script .= "document.form1.$priv"."_s.checked = true;\n"; } else { $return_script .= "document.form1.$priv"."_s.checked = false;\n"; } } $return_script .= '}'."\n"; return ($return_script); } # ---------------------------------------------------------- sub make_button_code { my ($role) = @_; my $label = &Apache::lonnet::plaintext($role); my $button_code = ''; return ($button_code); } # ---------------------------------------------------------- Call to definerole sub set_custom_role { my ($r) = @_; my $rolename=$env{'form.rolename'}; $rolename=~s/[^A-Za-z0-9]//gs; if (!$rolename) { &print_username_entry_form($r); return; } my ($jsback,$elements) = &crumb_utilities(); my $jscript = ''; $r->print(&Apache::loncommon::start_page('Save Custom Role'),$jscript); &Apache::lonhtmlcommon::add_breadcrumb ({href=>"javascript:backPage(document.customresult,'','')", text=>"User modify/custom role edit", 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',}); $r->print(&Apache::lonhtmlcommon::breadcrumbs('User Management')); 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=''; } $r->print($rolename.'"

'); # ------------------------------------------------------- What can be assigned? my $sysrole=''; my $domrole=''; my $courole=''; foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:c'})) { my ($priv,$restrict)=split(/\&/,$item); if (!$restrict) { $restrict=''; } if ($env{'form.'.$priv.'_c'}) { $courole.=':'.$item; } } foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:d'})) { my ($priv,$restrict)=split(/\&/,$item); if (!$restrict) { $restrict=''; } if ($env{'form.'.$priv.'_d'}) { $domrole.=':'.$item; } } foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:s'})) { my ($priv,$restrict)=split(/\&/,$item); if (!$restrict) { $restrict=''; } if ($env{'form.'.$priv.'_s'}) { $sysrole.=':'.$item; } } $r->print('
Defining Role: '. &Apache::lonnet::definerole($rolename,$sysrole,$domrole,$courole)); if ($env{'request.course.id'}) { my $url='/'.$env{'request.course.id'}; $url=~s/\_/\//g; $r->print('
'.&mt('Assigning Role to Self').': '. &Apache::lonnet::assigncustomrole($env{'user.domain'}, $env{'user.name'}, $url, $env{'user.domain'}, $env{'user.name'}, $rolename)); } $r->print('

Create another role, or Create/Modify a user.

'); $r->print(&Apache::lonhtmlcommon::echo_form_input([]).'
'); $r->print(&Apache::loncommon::end_page()); } # ================================================================ Main Handler sub handler { my $r = shift; if ($r->header_only) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; return OK; } if ((&Apache::lonnet::allowed('cta',$env{'request.course.id'})) || (&Apache::lonnet::allowed('cin',$env{'request.course.id'})) || (&Apache::lonnet::allowed('ccr',$env{'request.course.id'})) || (&Apache::lonnet::allowed('cep',$env{'request.course.id'})) || (&authorpriv($env{'user.name'},$env{'request.role.domain'})) || (&Apache::lonnet::allowed('mau',$env{'request.role.domain'}))) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; &Apache::lonhtmlcommon::clear_breadcrumbs(); my $phase = $env{'form.phase'}; my @search = ('srchterm','srchby','srchin','srchtype','srchdomain'); if (($phase eq 'get_user_info') || ($phase eq 'userpicked')) { my $srch; foreach my $item (@search) { $srch->{$item} = $env{'form.'.$item}; } if ($env{'form.phase'} eq 'get_user_info') { my ($currstate,$response,$forcenewuser,$results) = &user_search_result($srch); if ($currstate eq 'select') { &print_user_selection_page($r,$response,$srch,$results,'createuser',\@search); } elsif ($currstate eq 'modify') { my ($ccuname,$ccdomain); if (($srch->{'srchby'} eq 'uname') && ($srch->{'srchtype'} eq 'exact')) { $ccuname = $srch->{'srchterm'}; $ccdomain= $srch->{'srchdomain'}; } else { my @matchedunames = keys(%{$results}); ($ccuname,$ccdomain) = split(/:/,$matchedunames[0]); } $ccuname =&LONCAPA::clean_username($ccuname); $ccdomain=&LONCAPA::clean_domain($ccdomain); &print_user_modification_page($r,$ccuname,$ccdomain,$srch, $response); } elsif ($currstate eq 'query') { &print_user_query_page($r,'createuser'); } else { &print_username_entry_form($r,$response,$srch,$forcenewuser); } } elsif ($env{'form.phase'} eq 'userpicked') { my $ccuname = &LONCAPA::clean_username($env{'form.seluname'}); my $ccdomain = &LONCAPA::clean_domain($env{'form.seludom'}); &print_user_modification_page($r,$ccuname,$ccdomain,$srch); } } elsif ($env{'form.phase'} eq 'update_user_data') { &update_user_data($r); } elsif ($env{'form.phase'} eq 'selected_custom_edit') { &custom_role_editor($r); } elsif ($env{'form.phase'} eq 'set_custom_roles') { &set_custom_role($r); } else { &print_username_entry_form($r); } } else { $env{'user.error.msg'}= "/adm/createuser:mau:0:0:Cannot modify user data"; return HTTP_NOT_ACCEPTABLE; } return OK; } #-------------------------------------------------- functions for &phase_two sub user_search_result { my ($srch) = @_; my %allhomes; my %inst_matches; my %srch_results; my ($response,$currstate,$forcenewuser,$dirsrchres); $srch->{'srchterm'} =~ s/\s+/ /g; if ($srch->{'srchby'} !~ /^(uname|lastname|lastfirst)$/) { $response = &mt('Invalid search.'); } if ($srch->{'srchin'} !~ /^(crs|dom|alc|instd)$/) { $response = &mt('Invalid search.'); } if ($srch->{'srchtype'} !~ /^(exact|contains|begins)$/) { $response = &mt('Invalid search.'); } if ($srch->{'srchterm'} eq '') { $response = &mt('You must enter a search term.'); } if ($srch->{'srchterm'} =~ /^\s+$/) { $response = &mt('Your search term must contain more than just spaces.'); } if (($srch->{'srchin'} eq 'dom') || ($srch->{'srchin'} eq 'instd')) { if (($srch->{'srchdomain'} eq '') || ! (&Apache::lonnet::domain($srch->{'srchdomain'}))) { $response = &mt('You must specify a valid domain when searching in a domain or institutional directory.') } } if (($srch->{'srchin'} eq 'dom') || ($srch->{'srchin'} eq 'crs') || ($srch->{'srchin'} eq 'alc')) { if ($srch->{'srchby'} eq 'uname') { if ($srch->{'srchterm'} !~ /^$match_username$/) { $response = &mt('You must specify a valid username. Only the following are allowed: letters numbers - . @'); } } } if ($response ne '') { $response = ''.$response.''; } if ($srch->{'srchin'} eq 'instd') { my $instd_chk = &directorysrch_check($srch); if ($instd_chk ne 'ok') { $response = ''.$instd_chk.''. '
'.&mt('You may want to search in the LON-CAPA domain instead of the institutional directory.').'

'; } } if ($response ne '') { return ($currstate,$response); } if ($srch->{'srchby'} eq 'uname') { if (($srch->{'srchin'} eq 'dom') || ($srch->{'srchin'} eq 'crs')) { if ($env{'form.forcenew'}) { if ($srch->{'srchdomain'} ne $env{'request.role.domain'}) { my $uhome=&Apache::lonnet::homeserver($srch->{'srchterm'},$srch->{'srchdomain'}); if ($uhome eq 'no_host') { my $domdesc = &Apache::lonnet::domain($env{'request.role.domain'},'description'); my $showdom = &display_domain_info($env{'request.role.domain'}); $response = &mt('New users can only be created in the domain to which your current role belongs - [_1].',$showdom); } else { $currstate = 'modify'; } } else { $currstate = 'modify'; } } else { if ($srch->{'srchin'} eq 'dom') { if ($srch->{'srchtype'} eq 'exact') { my $uhome=&Apache::lonnet::homeserver($srch->{'srchterm'},$srch->{'srchdomain'}); if ($uhome eq 'no_host') { ($currstate,$response,$forcenewuser) = &build_search_response($srch,%srch_results); } else { $currstate = 'modify'; } } else { %srch_results = &Apache::lonnet::usersearch($srch); ($currstate,$response,$forcenewuser) = &build_search_response($srch,%srch_results); } } else { my $courseusers = &get_courseusers(); if ($srch->{'srchtype'} eq 'exact') { if (exists($courseusers->{$srch->{'srchterm'}.':'.$srch->{'srchdomain'}})) { $currstate = 'modify'; } else { ($currstate,$response,$forcenewuser) = &build_search_response($srch,%srch_results); } } else { foreach my $user (keys(%$courseusers)) { my ($cuname,$cudomain) = split(/:/,$user); if ($cudomain eq $srch->{'srchdomain'}) { my $matched = 0; if ($srch->{'srchtype'} eq 'begins') { if ($cuname =~ /^\Q$srch->{'srchterm'}\E/i) { $matched = 1; } } else { if ($cuname =~ /\Q$srch->{'srchterm'}\E/i) { $matched = 1; } } if ($matched) { $srch_results{$user} = {&Apache::lonnet::get('environment', ['firstname', 'lastname', 'permanentemail'])}; } } } ($currstate,$response,$forcenewuser) = &build_search_response($srch,%srch_results); } } } } elsif ($srch->{'srchin'} eq 'alc') { $currstate = 'query'; } elsif ($srch->{'srchin'} eq 'instd') { ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query($srch); if ($dirsrchres eq 'ok') { ($currstate,$response,$forcenewuser) = &build_search_response($srch,%srch_results); } else { my $showdom = &display_domain_info($srch->{'srchdomain'}); $response = ''. &mt('Institutional directory search is not available in domain: [_1]',$showdom). '
'. &mt('You may want to search in the LON-CAPA domain instead of the institutional directory.'). '

'; } } } else { if ($srch->{'srchin'} eq 'dom') { %srch_results = &Apache::lonnet::usersearch($srch); ($currstate,$response,$forcenewuser) = &build_search_response($srch,%srch_results); } elsif ($srch->{'srchin'} eq 'crs') { my $courseusers = &get_courseusers(); foreach my $user (keys(%$courseusers)) { my ($uname,$udom) = split(/:/,$user); my %names = &Apache::loncommon::getnames($uname,$udom); my %emails = &Apache::loncommon::getemails($uname,$udom); if ($srch->{'srchby'} eq 'lastname') { if ((($srch->{'srchtype'} eq 'exact') && ($names{'lastname'} eq $srch->{'srchterm'})) || (($srch->{'srchtype'} eq 'begins') && ($names{'lastname'} =~ /^\Q$srch->{'srchterm'}\E/i)) || (($srch->{'srchtype'} eq 'contains') && ($names{'lastname'} =~ /\Q$srch->{'srchterm'}\E/i))) { $srch_results{$user} = {firstname => $names{'firstname'}, lastname => $names{'lastname'}, permanentemail => $emails{'permanentemail'}, }; } } elsif ($srch->{'srchby'} eq 'lastfirst') { my ($srchlast,$srchfirst) = split(/,/,$srch->{'srchterm'}); $srchlast =~ s/\s+$//; $srchfirst =~ s/^\s+//; if ($srch->{'srchtype'} eq 'exact') { if (($names{'lastname'} eq $srchlast) && ($names{'firstname'} eq $srchfirst)) { $srch_results{$user} = {firstname => $names{'firstname'}, lastname => $names{'lastname'}, permanentemail => $emails{'permanentemail'}, }; } } elsif ($srch->{'srchtype'} eq 'begins') { if (($names{'lastname'} =~ /^\Q$srchlast\E/i) && ($names{'firstname'} =~ /^\Q$srchfirst\E/i)) { $srch_results{$user} = {firstname => $names{'firstname'}, lastname => $names{'lastname'}, permanentemail => $emails{'permanentemail'}, }; } } else { if (($names{'lastname'} =~ /\Q$srchlast\E/i) && ($names{'firstname'} =~ /\Q$srchfirst\E/i)) { $srch_results{$user} = {firstname => $names{'firstname'}, lastname => $names{'lastname'}, permanentemail => $emails{'permanentemail'}, }; } } } } ($currstate,$response,$forcenewuser) = &build_search_response($srch,%srch_results); } elsif ($srch->{'srchin'} eq 'alc') { $currstate = 'query'; } elsif ($srch->{'srchin'} eq 'instd') { ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query($srch); if ($dirsrchres eq 'ok') { ($currstate,$response,$forcenewuser) = &build_search_response($srch,%srch_results); } else { my $showdom = &display_domain_info($srch->{'srchdomain'}); $response = ''. &mt('Institutional directory search is not available in domain: [_1]',$showdom). '
'. &mt('You may want to search in the LON-CAPA domain instead of the institutional directory.'). '

'; } } } return ($currstate,$response,$forcenewuser,\%srch_results); } sub directorysrch_check { my ($srch) = @_; my $can_search = 0; my $response; my %dom_inst_srch = &Apache::lonnet::get_dom('configuration', ['directorysrch'],$srch->{'srchdomain'}); my $showdom = &display_domain_info($srch->{'srchdomain'}); if (ref($dom_inst_srch{'directorysrch'}) eq 'HASH') { if (!$dom_inst_srch{'directorysrch'}{'available'}) { return &mt('Institutional directory search is not available in domain: [_1]',$showdom); } if ($dom_inst_srch{'directorysrch'}{'localonly'}) { if ($env{'request.role.domain'} ne $srch->{'srchdomain'}) { return &mt('Institutional directory search in domain: [_1] is only allowed for users with a current role in the domain.',$showdom); } my @usertypes = split(/:/,$env{'environment.inststatus'}); if (!@usertypes) { push(@usertypes,'default'); } if (ref($dom_inst_srch{'directorysrch'}{'cansearch'}) eq 'ARRAY') { foreach my $type (@usertypes) { if (grep(/^\Q$type\E$/,@{$dom_inst_srch{'directorysrch'}{'cansearch'}})) { $can_search = 1; last; } } } if (!$can_search) { my ($insttypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($srch->{'srchdomain'}); my @longtypes; foreach my $item (@usertypes) { push (@longtypes,$insttypes->{$item}); } my $insttype_str = join(', ',@longtypes); return &mt('Institutional directory search in domain: [_1] is not available to your user type: ',$showdom).$insttype_str; } } else { $can_search = 1; } } else { return &mt('Institutional directory search has not been configured for domain: [_1]',$showdom); } my %longtext = &Apache::lonlocal::texthash ( uname => 'username', lastfirst => 'last name, first name', lastname => 'last name', contains => 'contains', exact => 'as exact match to', begins => 'begins with', ); if ($can_search) { if (ref($dom_inst_srch{'directorysrch'}{'searchby'}) eq 'ARRAY') { if (!grep(/^\Q$srch->{'srchby'}\E$/,@{$dom_inst_srch{'directorysrch'}{'searchby'}})) { return &mt('Institutional directory search in domain: [_1] is not available for searching by "[_2]"',$showdom,$longtext{$srch->{'srchby'}}); } } else { return &mt('Institutional directory search in domain: [_1] is not available.', $showdom); } } if ($can_search) { if (ref($dom_inst_srch{'directorysrch'}{'searchtypes'}) eq 'ARRAY') { if (grep(/^\Q$srch->{'srchtype'}\E/,@{$dom_inst_srch{'directorysrch'}{'searchtypes'}})) { return 'ok'; } else { return &mt('Institutional directory search in domain [_1] is not available for the requested search type: "[_2]"',$showdom,$longtext{$srch->{'srchtype'}}); } } else { if ((($dom_inst_srch{'directorysrch'}{'searchtypes'} eq 'specify') && ($srch->{'srchtype'} eq 'exact' || $srch->{'srchtype'} eq 'contains')) || ($dom_inst_srch{'directorysrch'}{'searchtypes'} eq $srch->{'srchtype'})) { return 'ok'; } else { return &mt('Institutional directory search in domain [_1] is not available for the requested search type: "[_2]"',$showdom,$longtext{$srch->{'srchtype'}}); } } } } sub get_courseusers { my %advhash; my $classlist = &Apache::loncoursedata::get_classlist(); my %coursepersonnel=&Apache::lonnet::get_course_adv_roles(); foreach my $role (sort(keys(%coursepersonnel))) { foreach my $user (split(/\,/,$coursepersonnel{$role})) { if (!exists($classlist->{$user})) { $classlist->{$user} = []; } } } return $classlist; } sub build_search_response { my ($srch,%srch_results) = @_; my ($currstate,$response,$forcenewuser); my %names = ( 'uname' => 'username', 'lastname' => 'last name', 'lastfirst' => 'last name, first name', 'crs' => 'this course', 'dom' => 'LON-CAPA domain: ', 'instd' => 'the institutional directory for domain: ', ); my %single = ( begins => 'A match', contains => 'A match', exact => 'An exact match', ); my %nomatch = ( begins => 'No match', contains => 'No match', exact => 'No exact match', ); if (keys(%srch_results) > 1) { $currstate = 'select'; } else { if (keys(%srch_results) == 1) { $currstate = 'modify'; $response = &mt("$single{$srch->{'srchtype'}} was found for the $names{$srch->{'srchby'}} ([_1]) in $names{$srch->{'srchin'}}.",$srch->{'srchterm'}); if ($srch->{'srchin'} eq 'dom' || $srch->{'srchin'} eq 'instd') { $response .= &display_domain_info($srch->{'srchdomain'}); } } else { $response = ''.&mt("$nomatch{$srch->{'srchtype'}} found for the $names{$srch->{'srchby'}} ([_1]) in $names{$srch->{'srchin'}}",$srch->{'srchterm'}); if ($srch->{'srchin'} eq 'dom' || $srch->{'srchin'} eq 'instd') { $response .= &display_domain_info($srch->{'srchdomain'}); } $response .= ''; if ($srch->{'srchin'} ne 'alc') { $forcenewuser = 1; my $cansrchinst = 0; if ($srch->{'srchdomain'}) { my %domconfig = &Apache::lonnet::get_dom('configuration',['directorysrch'],$srch->{'srchdomain'}); if (ref($domconfig{'directorysrch'}) eq 'HASH') { if ($domconfig{'directorysrch'}{'available'}) { $cansrchinst = 1; } } } if ((($srch->{'srchby'} eq 'lastfirst') || ($srch->{'srchby'} eq 'lastname')) && ($srch->{'srchin'} eq 'dom')) { if ($cansrchinst) { $response .= '
'.&mt('You may want to broaden your search to a search of the institutional directory for the domain.'); } } if ($srch->{'srchin'} eq 'crs') { $response .= '
'.&mt('You may want to broaden your search to the selected LON-CAPA domain.'); } } if (!($srch->{'srchby'} eq 'uname' && $srch->{'srchin'} eq 'dom' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchdomain'} eq $env{'request.role.domain'})) { my $showdom = &display_domain_info($env{'request.role.domain'}); $response .= '

'.&mt("To add a new user (you can only create new users in your current role's domain - [_1]):",$env{'request.role.domain'}).'
  • '.&mt("Set 'Domain/institution to search' to: [_1]",$showdom).'
  • '.&mt("Set 'Search criteria' to: 'username is ...... in selected LON-CAPA domain'").'
  • '.&mt('Provide the proposed username').'
  • '.&mt('Search').'

'; } } } return ($currstate,$response,$forcenewuser); } sub display_domain_info { my ($dom) = @_; my $output = $dom; if ($dom ne '') { my $domdesc = &Apache::lonnet::domain($dom,'description'); if ($domdesc ne '') { $output .= ' ('.$domdesc.')'; } } return $output; } sub crumb_utilities { my %elements = ( crtuser => { srchterm => 'text', srchin => 'selectbox', srchby => 'selectbox', srchtype => 'selectbox', srchdomain => 'selectbox', }, docustom => { rolename => 'selectbox', newrolename => 'textbox', }, studentform => { srchterm => 'text', srchin => 'selectbox', srchby => 'selectbox', srchtype => 'selectbox', srchdomain => 'selectbox', }, ); my $jsback .= qq| function backPage(formname,prevphase,prevstate) { formname.phase.value = prevphase; formname.currstate.value = prevstate; formname.submit(); } |; return ($jsback,\%elements); } sub course_level_table { my (%inccourses) = @_; my $table = ''; # Custom Roles? my %customroles=&my_custom_roles(); my %lt=&Apache::lonlocal::texthash( 'exs' => "Existing sections", 'new' => "Define new section", 'ssd' => "Set Start Date", 'sed' => "Set End Date", 'crl' => "Course Level", 'act' => "Activate", 'rol' => "Role", 'ext' => "Extent", 'grs' => "Section", 'sta' => "Start", 'end' => "End" ); foreach my $protectedcourse (sort( keys(%inccourses))) { my $thiscourse=$protectedcourse; $thiscourse=~s:_:/:g; my %coursedata=&Apache::lonnet::coursedescription($thiscourse); my $area=$coursedata{'description'}; my $type=$coursedata{'type'}; if (!defined($area)) { $area=&mt('Unavailable course').': '.$protectedcourse; } my ($domain,$cnum)=split(/\//,$thiscourse); my %sections_count; if (defined($env{'request.course.id'})) { if ($env{'request.course.id'} eq $domain.'_'.$cnum) { %sections_count = &Apache::loncommon::get_sections($domain,$cnum); } } foreach my $role ('st','ta','ep','in','cc') { if (&Apache::lonnet::allowed('c'.$role,$thiscourse)) { my $plrole=&Apache::lonnet::plaintext($role); $table .= &Apache::loncommon::start_data_table_row(). ' '.$plrole.' '.$area.'
Domain: '.$domain.''."\n"; if ($role ne 'cc') { if (%sections_count) { my $currsec = &course_sections(\%sections_count,$protectedcourse.'_'.$role); $table .= ''. ''. ''. ''. '
'.$lt{'exs'}.'
'. $currsec.'
   '.$lt{'new'}.'
'. ''. '
'; } else { $table .= ''; } } else { $table .= ' '; } $table .= < $lt{'ssd'} $lt{'sed'} ENDTIMEENTRY $table.= &Apache::loncommon::end_data_table_row(); } } foreach my $cust (sort keys %customroles) { if (&Apache::lonnet::allowed('ccr',$thiscourse)) { my $plrole=$cust; my $customrole=$protectedcourse.'_cr_cr_'.$env{'user.domain'}. '_'.$env{'user.name'}.'_'.$plrole; $table .= &Apache::loncommon::start_data_table_row(). ' '.$plrole.' '.$area.''."\n"; if (%sections_count) { my $currsec = &course_sections(\%sections_count,$customrole); $table.= ''. ''. ''. ''. ''. '
'.$lt{'exs'}.'
'. $currsec.'
   '.$lt{'new'}.'
'. '
'; } else { $table .= ''; } $table .= < $lt{'ssd'} $lt{'sed'} ENDENTRY $table .= &Apache::loncommon::end_data_table_row(); } } } return '' if ($table eq ''); # return nothing if there is nothing # in the table my $result = '

'.$lt{'crl'}.'

'. &Apache::loncommon::start_data_table(). &Apache::loncommon::start_data_table_header_row(). ''.$lt{'act'}.''.$lt{'rol'}.''.$lt{'ext'}.' '.$lt{'grs'}.''.$lt{'sta'}.''.$lt{'end'}.''. &Apache::loncommon::end_data_table_header_row(). $table. &Apache::loncommon::end_data_table(); return $result; } sub course_sections { my ($sections_count,$role) = @_; my $output = ''; my @sections = (sort {$a <=> $b} keys %{$sections_count}); if (scalar(@sections) == 1) { $output = ''."\n"; foreach my $sec (@sections) { $output .= '\n"; } } $output .= ''; return $output; } sub course_level_dc { my ($dcdom) = @_; my %customroles=&my_custom_roles(); my $hiddenitems = ''. ''. ''; my $courseform=''.&Apache::loncommon::selectcourse_link ('cu','dccourse','dcdomain','coursedesc',undef,undef,'Course').''; my $cb_jscript = &Apache::loncommon::coursebrowser_javascript($dcdom,'currsec','cu'); my %lt=&Apache::lonlocal::texthash( 'rol' => "Role", 'grs' => "Section", 'exs' => "Existing sections", 'new' => "Define new section", 'sta' => "Start", 'end' => "End", 'ssd' => "Set Start Date", 'sed' => "Set End Date" ); my $header = '

'.&mt('Course Level').'

'. &Apache::loncommon::start_data_table(). &Apache::loncommon::start_data_table_header_row(). ''.$courseform.''.$lt{'rol'}.''.$lt{'grs'}.''.$lt{'sta'}.''.$lt{'end'}.''. &Apache::loncommon::end_data_table_header_row(); my $otheritems = &Apache::loncommon::start_data_table_row()."\n". ''."\n". ''. ''. ''. ''. ''. '
'.$lt{'exs'}.'
   '.$lt{'new'}.'
'. ''. '
'; $otheritems .= < $lt{'ssd'} $lt{'sed'} ENDTIMEENTRY $otheritems .= &Apache::loncommon::end_data_table_row(). &Apache::loncommon::end_data_table()."\n"; return $cb_jscript.$header.$hiddenitems.$otheritems; } #---------------------------------------------- end functions for &phase_two #--------------------------------- functions for &phase_two and &phase_three #--------------------------end of functions for &phase_two and &phase_three 1; __END__