--- loncom/interface/loncreateuser.pm 2001/02/15 00:57:41 1.1
+++ loncom/interface/loncreateuser.pm 2007/09/18 23:57:15 1.186
@@ -1,62 +1,2914 @@
-# The LearningOnline Network
+# The LearningOnline Network with CAPA
# Create a user
#
-# (Create a course
-# (My Desk
+# $Id: loncreateuser.pm,v 1.186 2007/09/18 23:57:15 raeburn Exp $
#
-# (Internal Server Error Handler
+# Copyright Michigan State University Board of Trustees
#
-# (Login Screen
-# 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14,
-# 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer)
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
-# 3/1/1 Gerd Kortemeyer)
+# 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.
#
-# 3/1 Gerd Kortemeyer)
+# 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.
#
-# 2/14 Gerd Kortemeyer)
+# 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
#
-# 2/14 Gerd Kortemeyer
+# /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'}.
+ ': '.
+ ' '.$lt{'defa'}.' ('.$defquota.' Mb). '.
+ ' '.
+ $lt{'cust'}.': '.
+ ' 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";
+
+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::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) = @_;
+ if (($ccuname eq '') || ($ccdomain eq '')) {
+ my $usermsg = &mt('No username and/or domain provided.');
+ &print_username_entry_form($r,$usermsg);
+ return;
+ }
+ my ($instsrch,$rulematch,$rules,%inst_results);
+ my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
+ if ($uhome eq 'no_host') {
+ $instsrch =
+ {
+ srchin => 'instd',
+ srchby => 'uname',
+ srchtype => 'exact',
+ srchterm => $ccuname,
+ srchdomain => $ccdomain,
+ };
+ (my $usercheckmsg,$rulematch,$rules,%inst_results) =
+ &Apache::loncommon::username_rule_check($instsrch,'new');
+ if ($usercheckmsg) {
+ &print_username_entry_form($r,$usercheckmsg);
+ 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";
+".&Apache::loncommon::end_page());
+}
+
+sub set_login {
+ my $response = (<$generalrule
+$authformkrb
+$authformint
+$authformfsys
+$authformloc
+ENDAUTH
+ return $response;
+}
+
+# ================================================================= 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(<
+
+
+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::loncommon::end_page());
+}
+
+# ================================================================ Main Handler
sub handler {
my $r = shift;
if ($r->header_only) {
- $r->content_type('text/html');
+ &Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
return OK;
}
- if (&Apache::lonnet::allowed('ccc',$ENV{'user.domain'})) {
- $r->content_type('text/html');
+ 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');
-
- $r->print(<
-
-The LearningOnline Network with CAPA
-
-
-Create User, Change User Privileges
-
-
-