# The LearningOnline Network with CAPA
# Create a user
#
# $Id: loncreateuser.pm,v 1.149 2007/05/29 17:48:44 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</home/httpd/lonTabs/rolesplain.tab>.

Custom role definitions are stored in the C<roles.db> 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 lib '/home/httpd/lib/perl/';
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";
<script type="text/javascript">
function quota_changes(caller) {
    if (caller == "custom") {
        if (document.cu.customquota[0].checked) {
            document.cu.portfolioquota.value = "";
        }
    }
    if (caller == "quota") {
        document.cu.customquota[1].checked = true;
    }
}
</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.
                 '<h3>'.$lt{'disk'}.'</h3>'.
                 $lt{'cuqu'}.': '.$currquota.'&nbsp;Mb.&nbsp;&nbsp;'.
                 $defaultinfo.'<br /><span class="LC_nobreak">'.$lt{'chqu'}.
                 ': <label>'.
                 '<input type="radio" name="customquota" value="0" '.
                 $custom_off.' onchange="javascript:quota_changes('."'custom'".')"
                  />'.$lt{'defa'}.'&nbsp;('.$defquota.' Mb).</label>&nbsp;'.
                 '&nbsp;<label><input type="radio" name="customquota" value="1" '. 
                 $custom_on.'  onchange="javascript:quota_changes('."'custom'".')" />'.
                 $lt{'cust'}.':</label>&nbsp;'.
                 '<input type="text" name="portfolioquota" size ="5" value="'.
                 $showquota.'" onfocus="javascript:quota_changes('."'quota'".')" '.
                 '/>&nbsp;Mb';
    return $output;
}

# =================================================================== Phase one

sub print_username_entry_form {
    my ($r) = @_;
    my $defdom=$env{'request.role.domain'};
    my $domform = &Apache::loncommon::select_dom_form($defdom,'ccdomain');
    my $selscript=&Apache::loncommon::studentbrowser_javascript();
    my $start_page =
	&Apache::loncommon::start_page('Create Users, Change User Privileges',
				       $selscript);

    my $sellink=&Apache::loncommon::selectstudent_link
                                        ('crtuser','ccuname','ccdomain');
    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(
		    'siur'   => "Set Individual User Roles",
		    'usr'  => "Username",
                    'dom'  => "Domain",
                    'usrr' => "User Roles",
                    'ecrp' => "Edit Custom Role Privileges",
                    'nr'   => "Name of Role",
                    'cre'  => "Custom Role Editor"
				       );
    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');
    $r->print(<<"ENDDOCUMENT");
$start_page
<form action="/adm/createuser" method="post" name="crtuser">
<input type="hidden" name="phase" value="get_user_info">
<h2>$lt{siur}$helpsiur</h2>
<table>
<tr><td>$lt{usr}:</td><td><input type="text" size="15" name="ccuname">
</td><td rowspan="2">$sellink</td></tr><tr><td>
$lt{'dom'}:</td><td>$domform</td></tr>
</table>
<input name="userrole" type="submit" value="$lt{usrr}" />
</form>
ENDDOCUMENT
   if (&Apache::lonnet::allowed('mcr','/')) {
       $r->print(<<ENDCUSTOM);
<form action="/adm/createuser" method="post" name="docustom">
<input type="hidden" name="phase" value="selected_custom_edit">
<h2>$lt{'ecrp'}$helpecpr</h2>
$lt{'nr'}: $choice <input type="text" size="15" name="newrolename" /><br />
<input name="customeditor" type="submit" value="$lt{'cre'}" />
</form>
ENDCUSTOM
    }
    $r->print(&Apache::loncommon::end_page());
}


sub user_modification_js {
    my ($pjump_def,$dc_setcourse_code,$nondc_setsection_code,$groupslist)=@_;
    
    return <<END;
<script type="text/javascript" language="Javascript">

    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

</script>
END
}

# =================================================================== Phase two
sub print_user_modification_page {
    my $r=shift;
    my $ccuname =&LONCAPA::clean_username($env{'form.ccuname'});
    my $ccdomain=&LONCAPA::clean_domain($env{'form.ccdomain'});

    unless (($ccuname) && ($ccdomain)) {
	&print_username_entry_form($r);
        return;
    }

    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);

    $ccuname =&LONCAPA::clean_username($ccuname);
    $ccdomain=&LONCAPA::clean_domain($ccdomain);
    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<document.cu.currsec.length; i++) {
                if (document.cu.currsec.options[i].selected == true ) {
                    if (document.cu.currsec.options[i].value != "" && document.cu.currsec.options[i].value != null) { 
                        if (numsections == 0) {
                            section = document.cu.currsec.options[i].value
                            numsections = 1;
                        }
                        else {
                            section = section + "," +  document.cu.currsec.options[i].value
                            numsections ++;
                        }
                    }
                }
            }
            if (document.cu.newsec.value != "" && document.cu.newsec.value != null) {
                if (numsections == 0) {
                    section = document.cu.newsec.value
                }
                else {
                    section = section + "," +  document.cu.newsec.value
                }
                newsecs = document.cu.newsec.value.split(/,/g);
                numsections = numsections + newsecs.length;
            }
            if ((userrole == 'st') && (numsections > 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<newsecs.length; j++) {
                if ((newsecs[j] == 'all') || (newsecs[j] == 'none')) {
                    alert("'"+newsecs[j]+"' may not be used as the name for a section, as it is a reserved word.\\nPlease choose a different section name.");
                    return;
                }
                if (document.cu.groups.value != '') {
                    var groups = document.cu.groups.value.split(/,/g);
                    for (var k=0; k<groups.length; k++) {
                        if (newsecs[j] == groups[k]) {
                            alert("'"+newsecs[j]+"' may not be used as the name for a section, as it is the name of a course group.\\nSection names and group names must be distinct. Please choose a different section name.");
                            return; 
                        }
                    }
                }
            }
            if ((userrole == 'cc') && (numsections > 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<document.cu.elements.length;i++) {
            if (document.cu.elements[i] == caller) {
                return i;
            }
        }
        return -1;
    }
ENDSCRIPT
    } else {
        $nondc_setsection_code = <<"ENDSECCODE";
    function setSections() {
        var re1 = /^currsec_/;
        var groups = new Array($groupslist);
        for (var i=0;i<document.cu.elements.length;i++) {
            var str = document.cu.elements[i].name;
            var checkcurr = str.match(re1);
            if (checkcurr != null) {
                if (document.cu.elements[i-1].checked == true) {
                    var re2 = /^currsec_[a-zA-Z0-9]+_[a-zA-Z0-9]+_(\\w+)\$/;
                    match = re2.exec(str);
                    var role = match[1];
                    if (role == 'cc') {
                        alert("Section designations do not apply to Course Coordinator roles.\\nA course coordinator role will be added with access to all sections.");
                    }
                    else {
                        var sections = '';
                        var numsec = 0;
                        var sections;
                        for (var j=0; j<document.cu.elements[i].length; j++) {
                            if (document.cu.elements[i].options[j].selected == true ) {
                                if (document.cu.elements[i].options[j].value != "") {
                                    if (numsec == 0) {
                                        if (document.cu.elements[i].options[j].value != "") {
                                            sections = document.cu.elements[i].options[j].value;
                                            numsec ++;
                                        }
                                    }
                                    else {
                                        sections = sections + "," +  document.cu.elements[i].options[j].value
                                        numsec ++;
                                    }
                                }
                            }
                        }
                        if (numsec > 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<numsplit.length; j++) {
                                if ((numsplit[j] == 'all') ||
                                    (numsplit[j] == 'none')) {
                                    alert("'"+numsplit[j]+"' may not be used as the name for a section, as it is a reserved word.\\nPlease choose a different section name.");
                                    return;
                                }
                                for (var k=0; k<groups.length; k++) {
                                    if (numsplit[j] == groups[k]) {
                                        alert("'"+numsplit[j]+"' may not be used as a section name, as it is the name of a course group.\\nSection names and group names must be distinct. Please choose a different section name.");
                                        return;
                                    }
                                }
                            }
                        }
                        document.cu.elements[i+2].value = sections;
                    }
                }
            }
        }
        document.cu.submit();
    }
ENDSECCODE
    }
    my $js = &user_modification_js($pjump_def,$dc_setcourse_code,
                                   $nondc_setsection_code,$groupslist);
    my $start_page = 
	&Apache::loncommon::start_page('Create Users, Change User Privileges',
				       $js,{'add_entries' => \%loaditem,});

    my $forminfo =<<"ENDFORMINFO";
<form action="/adm/createuser" method="post" name="cu">
<input type="hidden" name="phase"       value="update_user_data">
<input type="hidden" name="ccuname"     value="$ccuname">
<input type="hidden" name="ccdomain"    value="$ccdomain">
<input type="hidden" name="pres_value"  value="" >
<input type="hidden" name="pres_type"   value="" >
<input type="hidden" name="pres_marker" value="" >
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 $home_server_list=
            '<option value="default" selected>default</option>'."\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",
                    '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(<<ENDNEWUSER);
$start_page
<h1>$lt{'cnu'}</h1>
$forminfo
<h2>$lt{'nu'} "$ccuname" $lt{'id'} $ccdomain</h2>
<script type="text/javascript" language="Javascript">
$loginscript
</script>
<input type='hidden' name='makeuser' value='1' />
<h3>$lt{'pd'}</h3>
<p>
<table>
<tr><td>$lt{'fn'}  </td>
    <td><input type='text' name='cfirst'  size='15' /></td></tr>
<tr><td>$lt{'mn'} </td> 
    <td><input type='text' name='cmiddle' size='15' /></td></tr>
<tr><td>$lt{'ln'}   </td>
    <td><input type='text' name='clast'   size='15' /></td></tr>
<tr><td>$lt{'gen'}$genhelp</td>
    <td><input type='text' name='cgen'    size='5'  /></td></tr>
</table>
$lt{'idsn'} <input type='text' name='cstid'   size='15' /></p>
$lt{'hs'}: <select name="hserver" size="1"> $home_server_list </select>
<hr />
<h3>$lt{'lg'}</h3>
<p>$generalrule </p>
<p>$authformkrb </p>
<p>$authformint </p>
<p>$authformfsys</p>
<p>$authformloc </p>
<hr />
$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"
				       );
	$r->print(<<ENDCHANGEUSER);
$start_page
<h1>$lt{'cup'}</h1>
$forminfo
<h2>$lt{'usr'} "$ccuname" $lt{'id'} "$ccdomain"</h2>
ENDCHANGEUSER
        # Get the users information
        my %userenv = &Apache::lonnet::get('environment',
                          ['firstname','middlename','lastname','generation',
                           'portfolioquota'],$ccdomain,$ccuname);
        my %rolesdump=&Apache::lonnet::dump('roles',$ccdomain,$ccuname);
        $r->print('
<hr />'.
                  &Apache::loncommon::start_data_table().
                  &Apache::loncommon::start_data_table_header_row().
'<th>'.$lt{'fn'}.'</th><th>'.$lt{'mn'}.'</th><th>'.$lt{'ln'}.'</th><th>'.$lt{'gen'}.'</th>'.
                  &Apache::loncommon::end_data_table_header_row().
                  &Apache::loncommon::start_data_table_row());
        foreach my $item ('firstname','middlename','lastname','generation') {
           if (&Apache::lonnet::allowed('mau',$ccdomain)) {
              $r->print(<<"END");
<td><input type="text" name="c$item" value="$userenv{$item}" size="15" /></td>
END
           } else {
               $r->print('<td>'.$userenv{$item}.'</td>');
           }
        }
        $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'}.
                           '<br />'.&mt('Domain').': '.$coursedom.('&nbsp;'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.='<br />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.= '<td>';
               my $active=1;
               $active=0 if (($role_end_time) && ($now>$role_end_time));
               if (($active) && ($allowed)) {
                   $row.= '<input type="checkbox" name="rev:'.$thisrole.'">';
               } else {
                   if ($active) {
                      $row.='&nbsp;';
		   } else {
                      $row.=&mt('expired or revoked');
		   }
               }
	       $row.='</td><td>';
               if ($allowed && !$active) {
                   $row.= '<input type="checkbox" name="ren:'.$thisrole.'">';
               } else {
                   $row.='&nbsp;';
               }
	       $row.='</td><td>';
               if ($delallowed) {
                   $row.= '<input type="checkbox" name="del:'.$thisrole.'">';
               } else {
                   $row.='&nbsp;';
               }
	       my $plaintext='';
	       unless ($croletitle) {
                   $plaintext=&Apache::lonnet::plaintext($role_code,$class)
	       } else {
	           $plaintext=
		"Customrole '$croletitle' defined by $croleuname\@$croleudom";
	       }
               $row.= '</td><td>'.$plaintext.
                      '</td><td>'.$area.
                      '</td><td>'.($role_start_time?localtime($role_start_time)
                                                   : '&nbsp;' ).
                      '</td><td>'.($role_end_time  ?localtime($role_end_time)
                                                   : '&nbsp;' )
                      ."</td>";
	       $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} = '<tr class="LC_info_row">'.
			     "<td align='center' colspan='7'>".&mt($type)."</td></tr>".
                              $output{$type};
                   $rolesdisplay = 1;
	       }
	   }
           if ($rolesdisplay == 1) {
               $r->print('
<hr />
<h3>'.$lt{'rer'}.'</h3>'.
&Apache::loncommon::start_data_table("LC_createuser").
&Apache::loncommon::start_data_table_header_row().
'<th>'.$lt{'rev'}.'</th><th>'.$lt{'ren'}.'</th><th>'.$lt{'del'}.
'</th><th>'.$lt{'rol'}.'</th><th>'.$lt{'ext'}.
'</th><th>'.$lt{'sta'}.'</th><th>'.$lt{'end'}.'</th>'.
&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(<<ENDBADAUTH);
<hr />
<script type="text/javascript" language="Javascript">
$loginscript
</script>
<font color='#ff0000'>$lt{'err'}:</font>
$lt{'uuas'} ($currentauth). $lt{'sldb'}.
<h3>$lt{'ld'}</h3>
<p>$generalrule</p>
<p>$authformkrb</p>
<p>$authformint</p>
<p>$authformfsys</p>
<p>$authformloc</p>
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(<<ENDBADAUTH);
<hr />
<font color="#ff0000"> $lt{'err'}: </font>
$lt{'uuas'} ($currentauth). $lt{'adcs'}.
<hr />
ENDBADAUTH
            }
        } else { # Authentication type is valid
	    my $authformcurrent='';
	    my $authform_other='';
            &initialize_authen_forms();
	    if ($currentauth=~/^krb(4|5):/) {
		$authformcurrent=$authformkrb;
		$authform_other="<p>$authformint</p>\n".
                    "<p>$authformfsys</p><p>$authformloc</p>";
	    }
	    elsif ($currentauth=~/^internal:/) {
		$authformcurrent=$authformint;
		$authform_other="<p>$authformkrb</p>".
                    "<p>$authformfsys</p><p>$authformloc</p>";
	    }
	    elsif ($currentauth=~/^unix:/) {
		$authformcurrent=$authformfsys;
		$authform_other="<p>$authformkrb</p>".
                    "<p>$authformint</p><p>$authformloc;</p>";
	    }
	    elsif ($currentauth=~/^localauth:/) {
		$authformcurrent=$authformloc;
		$authform_other="<p>$authformkrb</p>".
                    "<p>$authformint</p><p>$authformfsys</p>";
	    }
            $authformcurrent.=' <i>(will override current values)</i><br />';
            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(<<ENDOTHERAUTHS);
<hr />
<script type="text/javascript" language="Javascript">
$loginscript
</script>
<h3>$lt{'ccld'}</h3>
<p>$generalrule</p>
<p>$authformnop</p>
<p>$authformcurrent</p>
<h3>$lt{'enld'}</h3>
$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(<<ENDNOPRIV);
<hr />
<h3>$lt{'ccld'}</h3>
$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('<hr /><h3>'.&mt('Add Roles').'</h3>');
#
# 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('<h4>'.$lt{'cs'}.'</h4>'."\n". 
           &Apache::loncommon::start_data_table()."\n".
           &Apache::loncommon::start_data_table_header_row()."\n".
           '<th>'.$lt{'act'}.'</th><th>'.$lt{'rol'}.'</th>'.
           '<th>'.$lt{'ext'}.'</th><th>'.$lt{'sta'}.'</th>'.
           '<th>'.$lt{'end'}.'</th>'."\n".
           &Apache::loncommon::end_data_table_header_row()."\n".
           &Apache::loncommon::start_data_table_row()."\n".
           '<td>
            <input type=checkbox name="act_'.$cudom.'_'.$cuname.'_ca" />
           </td>
           <td>'.$lt{'cau'}.'</td>
           <td>'.$cudom.'_'.$cuname.'</td>
           <td><input type="hidden" name="start_'.$cudom.'_'.$cuname.'_ca" value="" />
             <a href=
"javascript:pjump('."'date_start','Start Date Co-Author',document.cu.start_$cudom\_$cuname\_ca.value,'start_$cudom\_$cuname\_ca','cu.pres','dateset'".')">'.$lt{'ssd'}.'</a></td>
<td><input type=hidden name="end_'.$cudom.'_'.$cuname.'_ca" value="" />
<a href=
"javascript:pjump('."'date_end','End Date Co-Author',document.cu.end_$cudom\_$cuname\_ca.value,'end_$cudom\_$cuname\_ca','cu.pres','dateset'".')">'.$lt{'sed'}.'</a></td>'."\n".
          &Apache::loncommon::end_data_table_row()."\n".
          &Apache::loncommon::start_data_table_row()."\n".
'<td><input type=checkbox name="act_'.$cudom.'_'.$cuname.'_aa" /></td>
<td>'.$lt{'caa'}.'</td>
<td>'.$cudom.'_'.$cuname.'</td>
<td><input type=hidden name="start_'.$cudom.'_'.$cuname.'_aa" value="" />
<a href=
"javascript:pjump('."'date_start','Start Date Assistant Co-Author',document.cu.start_$cudom\_$cuname\_aa.value,'start_$cudom\_$cuname\_aa','cu.pres','dateset'".')">'.$lt{'ssd'}.'</a></td>
<td><input type=hidden name="end_'.$cudom.'_'.$cuname.'_aa" value="" />
<a href=
"javascript:pjump('."'date_end','End Date Assistant Co-Author',document.cu.end_$cudom\_$cuname\_aa.value,'end_$cudom\_$cuname\_aa','cu.pres','dateset'".')">'.$lt{'sed'}.'</a></td>'."\n".
         &Apache::loncommon::end_data_table_row()."\n".
         &Apache::loncommon::end_data_table());
    }
#
# Domain level
#
    my $num_domain_level = 0;
    my $domaintext = 
    '<h4>'.&mt('Domain Level').'</h4>'.
    &Apache::loncommon::start_data_table().
    &Apache::loncommon::start_data_table_header_row().
    '<th>'.&mt('Activate').'</th><th>'.&mt('Role').'</th><th>'.
    &mt('Extent').'</th>'.
    '<th>'.&mt('Start').'</th><th>'.&mt('End').'</th>'.
    &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().
'<td><input type=checkbox name="act_'.$thisdomain.'_'.$role.'"></td>
<td>'.$plrole.'</td>
<td>'.$thisdomain.'</td>
<td><input type=hidden name="start_'.$thisdomain.'_'.$role.'" value="">
<a href=
"javascript:pjump('."'date_start','Start Date $plrole',document.cu.start_$thisdomain\_$role.value,'start_$thisdomain\_$role','cu.pres','dateset'".')">'.$lt{'ssd'}.'</a></td>
<td><input type=hidden name="end_'.$thisdomain.'_'.$role.'" value="">
<a href=
"javascript:pjump('."'date_end','End Date $plrole',document.cu.end_$thisdomain\_$role.value,'end_$thisdomain\_$role','cu.pres','dateset'".')">'.$lt{'sed'}.'</a></td>'.
&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('<hr /><input type="button" value="'.&mt('Modify User').'" onClick="setCourse()">'."\n");
    } else {
        $r->print(&course_level_table(%inccourses));
        $r->print('<hr /><input type="button" value="'.&mt('Modify User').'" onClick="setSections()">'."\n");
    }
    $r->print("</form>".&Apache::loncommon::end_page());
}

# ================================================================= Phase Three
sub update_user_data {
    my $r=shift;
    my $uhome=&Apache::lonnet::homeserver($env{'form.ccuname'},
                                          $env{'form.ccdomain'});
    # Error messages
    my $error     = '<font color="#ff0000">'.&mt('Error').':</font>';
    my $end       = &Apache::loncommon::end_page();

    my $title;
    if (exists($env{'form.makeuser'})) {
	$title='Set Privileges for New User';
    } else {
        $title='Modify User Privileges';
    }
    $r->print(&Apache::loncommon::start_page($title));
    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, 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;
    }
    if ($env{'form.makeuser'}) {
        # Create a new user
	my %lt=&Apache::lonlocal::texthash(
                    'cru'  => "Creating user",                    
                    'id'   => "in domain"
					   );
	$r->print(<<ENDNEWUSERHEAD);
<h3>$lt{'cru'} "$env{'form.ccuname'}" $lt{'id'} "$env{'form.ccdomain'}"</h3>
ENDNEWUSERHEAD
        # 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
	     );
	$r->print(&mt('Generating user').': '.$result);
        my $home = &Apache::lonnet::homeserver($env{'form.ccuname'},
                                               $env{'form.ccdomain'});
        $r->print('<br />'.&mt('Home server').': '.$home.' '.
                  &Apache::lonnet::hostname($home));
    } elsif (($env{'form.login'} ne 'nochange') &&
             ($env{'form.login'} ne ''        )) {
	# Modify user privileges
    my %lt=&Apache::lonlocal::texthash(
                    'usr'  => "User",                    
                    'id'   => "in domain"
				       );
	$r->print(<<ENDMODIFYUSERHEAD);
<h2>$lt{'usr'} "$env{'form.ccuname'}" $lt{'id'} "$env{'form.ccdomain'}"</h2>
ENDMODIFYUSERHEAD
        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('<br />'.&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',
             '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') {
            # 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 = &quota_admin($newportfolioquota,\%changeHash);
                }
            } else {
                $quotachanged = &quota_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 = &quota_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'} )) {
            $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'};
            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",
                             'disk' => "disk space allocated to portfolio files",
                             'prvs' => "Previous",
                             'chto' => "Changed To"
						   );
                $r->print(<<"END");
<table border="2">
<caption>$lt{'uic'}</caption>
<tr><th>&nbsp;</th>
    <th>$lt{'frst'}</th>
    <th>$lt{'mddl'}</th>
    <th>$lt{'lst'}</th>
    <th>$lt{'gen'}</th>
    <th>$lt{'disk'}<th></tr>
<tr><td>$lt{'prvs'}</td>
    <td>$userenv{'firstname'}  </td>
    <td>$userenv{'middlename'} </td>
    <td>$userenv{'lastname'}   </td>
    <td>$userenv{'generation'} </td>
    <td>$oldportfolioquota Mb</td>
</tr>
<tr><td>$lt{'chto'}</td>
    <td>$env{'form.cfirstname'}  </td>
    <td>$env{'form.cmiddlename'} </td>
    <td>$env{'form.clastname'}   </td>
    <td>$env{'form.cgeneration'} </td>
    <td>$newportfolioquota Mb $defquotatext </td></tr>
</table>
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("<h2>".&mt('Unable to successfully change environment for')." ".
                      $env{'form.ccuname'}." ".&mt('in domain')." ".
                      $env{'form.ccdomain'}."</h2>");
            }
        }  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(
                           'usr'  => "User",                    
                           'id'   => "in domain",
                           'gen'  => "Generation",
                           'disk' => "Disk space allocated to user's portfolio files",
					       );
            $r->print(<<"END");
<h2>$lt{'usr'} "$env{'form.ccuname'}" $lt{'id'} "$env{'form.ccdomain'}"</h2>
<h4>$userenv{'firstname'} $userenv{'middlename'} $userenv{'lastname'} </h4>
<h4>$lt{'gen'}: $userenv{'generation'}</h4>
END
            if ($putresult eq 'ok') {
                if ($oldportfolioquota != $newportfolioquota) {
                    $r->print('<h4>'.$lt{'disk'}.': '.$newportfolioquota.' Mb '. 
                              $defquotatext.'</h4>');
                    &Apache::lonnet::appenv('environment.portfolioquota' => $changeHash{'portfolioquota'});
                }
            }
        }
    }
    ##
    my $now=time;
    $r->print('<h3>'.&mt('Modifying Roles').'</h3>');
    foreach my $key (keys (%env)) {
	next if (! $env{$key});
	# Revoke roles
	if ($key=~/^form\.rev/) {
	    if ($key=~/^form\.rev\:([^\_]+)\_([^\_\.]+)$/) {
# Revoke standard role
	        $r->print(&mt('Revoking').' '.$2.' in '.$1.': <b>'.
                     &Apache::lonnet::revokerole($env{'form.ccdomain'},
                     $env{'form.ccuname'},$1,$2).'</b><br />');
		if ($2 eq 'st') {
		    $1=~m{^/($match_domain)/($match_courseid)};
		    my $cid=$1.'_'.$2;
		    $r->print(&mt('Drop from classlist').': <b>'.
			 &Apache::lonnet::critical('put:'.
                             $env{'course.'.$cid.'.domain'}.':'.
	                     $env{'course.'.$cid.'.num'}.':classlist:'.
                         &escape($env{'form.ccuname'}.':'.
                             $env{'form.ccdomain'}).'='.
                         &escape($now.':'),
	                     $env{'course.'.$cid.'.home'}).'</b><br />');
		}
	    } 
	    if ($key=~m{^form\.rev\:([^_]+)_cr\.cr/($match_domain)/($match_username)/(\w+)$}) {
# Revoke custom role
		$r->print(&mt('Revoking custom role:').
                      ' '.$4.' by '.$3.':'.$2.' in '.$1.': <b>'.
                      &Apache::lonnet::revokecustomrole($env{'form.ccdomain'},
				  $env{'form.ccuname'},$1,$2,$3,$4).
		'</b><br />');
	    }
	} elsif ($key=~/^form\.del/) {
	    if ($key=~/^form\.del\:([^\_]+)\_([^\_\.]+)$/) {
# Delete standard role
	        $r->print(&mt('Deleting').' '.$2.' in '.$1.': '.
                     &Apache::lonnet::assignrole($env{'form.ccdomain'},
                     $env{'form.ccuname'},$1,$2,$now,0,1).'<br />');
		if ($2 eq 'st') {
		    $1=~m{^/($match_domain)/($match_courseid)};
		    my $cid=$1.'_'.$2;
		    $r->print(&mt('Drop from classlist').': <b>'.
			 &Apache::lonnet::critical('put:'.
                             $env{'course.'.$cid.'.domain'}.':'.
	                     $env{'course.'.$cid.'.num'}.':classlist:'.
                         &escape($env{'form.ccuname'}.':'.
                             $env{'form.ccdomain'}).'='.
                         &escape($now.':'),
	                     $env{'course.'.$cid.'.home'}).'</b><br />');
		}
            }
	    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).': <b>'.
                      &Apache::lonnet::assigncustomrole($env{'form.ccdomain'},
                         $env{'form.ccuname'},$url,$rdom,$rnam,$rolename,$now,
                         0,1).'</b><br />');
            }
	} 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).
                                      ': <br />'.$logmsg.'<br />'.
                                      &mt('Add to classlist').': <b>ok</b><br />';
                        }
                    }
                } else {
		    my $result=&Apache::lonnet::assignrole($env{'form.ccdomain'},
                               $env{'form.ccuname'},$url,$role,0,$now);
		    $output = &mt('Re-enabling [_1] in [_2]: <b>[_3]</b>',
			      $role,$url,$result).'<br />';
		}
                $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] : <b>[_5]</b>',
                          $rolename,$rnam,$rdom,$url,$result).'<br />');
            }
	} 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('<p>'.&mt('ERROR').': '.&mt('Unknown command').' <tt>'.$key.'</tt></p><br />');
            }
            foreach my $key (sort(keys(%disallowed))) {
                if (($key eq 'none') || ($key eq 'all')) {  
                    $r->print('<p>'.&mt('[_1] may not be used as the name for a section, as it is a reserved word.',$key));
                } else {
                    $r->print('<p>'.&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 <a href="javascript:history.go(-1)">go back</a> and choose a different section name.').'</p><br />');
            }
	}
    } # End of foreach (keys(%env))
# Flush the course logs so reverse user roles immediately updated
    &Apache::lonnet::flushcourselogs();
    $r->print('<p><a href="/adm/createuser">Create/Modify Another User</a></p>');
    $r->print(&Apache::loncommon::end_page());
}

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;
                unless ($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=shift;
    my $rolename=$env{'form.rolename'};

    if ($rolename eq 'make new role') {
	$rolename=$env{'form.newrolename'};
    }

    $rolename=~s/[^A-Za-z0-9]//gs;

    unless ($rolename) {
	&print_username_entry_form($r);
        return;
    }

    $r->print(&Apache::loncommon::start_page('Custom Role Editor'));
    my $syspriv='';
    my $dompriv='';
    my $coursepriv='';
    my ($rdummy,$roledef)=
			 &Apache::lonnet::get('roles',["rolesdef_$rolename"]);
# ------------------------------------------------------- Does this role exist?
    $r->print('<h2>');
    if (($rdummy ne 'con_lost') && ($roledef ne '')) {
	$r->print(&mt('Existing Role').' "');
# ------------------------------------------------- Get current role privileges
	($syspriv,$dompriv,$coursepriv)=split(/\_/,$roledef);
    } else {
	$r->print(&mt('New Role').' "');
	$roledef='';
    }
    $r->print($rolename.'"</h2>');
# ------------------------------------------------------- What can be assigned?
    my %full=();
    my %courselevel=();
    my %courselevelcurrent=();
    foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
	my ($priv,$restrict)=split(/\&/,$item);
        unless ($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);
        unless ($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);
        unless ($restrict) { $restrict='F'; }
        $systemlevel{$priv}=$restrict;
        if ($syspriv=~/\:$priv/) {
	    $systemlevelcurrent{$priv}=1;
	}
	$full{$priv}=1;
    }
    my %lt=&Apache::lonlocal::texthash(
		    'prv'  => "Privilege",
		    'crl'  => "Course Level",
                    'dml'  => "Domain Level",
                    'ssl'  => "System Level"
				       );
    $r->print(<<ENDCCF);
<form method="post">
<input type="hidden" name="phase" value="set_custom_roles" />
<input type="hidden" name="rolename" value="$rolename" />
ENDCCF
    $r->print(&Apache::loncommon::start_data_table().
              &Apache::loncommon::start_data_table_header_row(). 
'<th>'.$lt{'prv'}.'</th><th>'.$lt{'crl'}.'</th><th>'.$lt{'dml'}.
'</th><th>'.$lt{'ssl'}.'</th>'.
              &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().
	          '<td>'.$privtext.'</td><td>'.
    ($courselevel{$priv}?'<input type="checkbox" name="'.$priv.':c" '.
    ($courselevelcurrent{$priv}?'checked="1"':'').' />':'&nbsp;').
    '</td><td>'.
    ($domainlevel{$priv}?'<input type="checkbox" name="'.$priv.':d" '.
    ($domainlevelcurrent{$priv}?'checked="1"':'').' />':'&nbsp;').
    '</td><td>'.
    ($systemlevel{$priv}?'<input type="checkbox" name="'.$priv.':s" '.
    ($systemlevelcurrent{$priv}?'checked="1"':'').' />':'&nbsp;').
    '</td>'.
             &Apache::loncommon::end_data_table_row());
    }
    $r->print(&Apache::loncommon::end_data_table().
   '<input type="submit" value="'.&mt('Define Role').'" /></form>'.
	      &Apache::loncommon::end_page());
}

# ---------------------------------------------------------- Call to definerole
sub set_custom_role {
    my ($r) = @_;

    my $rolename=$env{'form.rolename'};

    $rolename=~s/[^A-Za-z0-9]//gs;

    unless ($rolename) {
	&print_username_entry_form($r);
        return;
    }

    $r->print(&Apache::loncommon::start_page('Save Custom Role').'<h2>');
    my ($rdummy,$roledef)=
	&Apache::lonnet::get('roles',["rolesdef_$rolename"]);

# ------------------------------------------------------- Does this role exist?
    if (($rdummy ne 'con_lost') && ($roledef ne '')) {
	$r->print(&mt('Existing Role').' "');
    } else {
	$r->print(&mt('New Role').' "');
	$roledef='';
    }
    $r->print($rolename.'"</h2>');
# ------------------------------------------------------- What can be assigned?
    my $sysrole='';
    my $domrole='';
    my $courole='';

    foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
	my ($priv,$restrict)=split(/\&/,$item);
        unless ($restrict) { $restrict=''; }
        if ($env{'form.'.$priv.':c'}) {
	    $courole.=':'.$item;
	}
    }

    foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:d'})) {
	my ($priv,$restrict)=split(/\&/,$item);
        unless ($restrict) { $restrict=''; }
        if ($env{'form.'.$priv.':d'}) {
	    $domrole.=':'.$item;
	}
    }

    foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:s'})) {
	my ($priv,$restrict)=split(/\&/,$item);
        unless ($restrict) { $restrict=''; }
        if ($env{'form.'.$priv.':s'}) {
	    $sysrole.=':'.$item;
	}
    }
    $r->print('<br />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('<br />'.&mt('Assigning Role to Self').': '.
	      &Apache::lonnet::assigncustomrole($env{'user.domain'},
						$env{'user.name'},
						$url,
						$env{'user.domain'},
						$env{'user.name'},
						$rolename));
    }
    $r->print('<p><a href="/adm/createuser">Create another role, or Create/Modify a user.</a></p>');
    $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;
       unless ($env{'form.phase'}) {
	   &print_username_entry_form($r);
       }
       if ($env{'form.phase'} eq 'get_user_info') {
           &print_user_modification_page($r);
       } 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 {
      $env{'user.error.msg'}=
        "/adm/createuser:mau:0:0:Cannot modify user data";
      return HTTP_NOT_ACCEPTABLE; 
   }
   return OK;
} 

#-------------------------------------------------- functions for &phase_two
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().
'<td><input type="checkbox" name="act_'.$protectedcourse.'_'.$role.'"></td>
<td>'.$plrole.'</td>
<td>'.$area.'<br />Domain: '.$domain.'</td>'."\n";
	        if ($role ne 'cc') {
                    if (%sections_count) {
                        my $currsec = &course_sections(\%sections_count,$protectedcourse.'_'.$role);
                        $table .= 
                    '<td><table class="LC_createuser">'.
                     '<tr class="LC_section_row">
                        <td valign="top">'.$lt{'exs'}.'<br />'.
                        $currsec.'</td>'.
                     '<td>&nbsp;&nbsp;</td>'.
                     '<td valign="top">&nbsp;'.$lt{'new'}.'<br />'.
                     '<input type="text" name="newsec_'.$protectedcourse.'_'.$role.'" value="" /></td>'.
                     '<input type="hidden" '.
                     'name="sec_'.$protectedcourse.'_'.$role.'"></td>'.
                     '</tr></table></td>';
                    } else {
                        $table .= '<td><input type="text" size="10" '.
                     'name="sec_'.$protectedcourse.'_'.$role.'"></td>';
                    }
                } else { 
		    $table .= '<td>&nbsp</td>';
                }
		$table .= <<ENDTIMEENTRY;
<td><input type=hidden name="start_$protectedcourse\_$role" value=''>
<a href=
"javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$role.value,'start_$protectedcourse\_$role','cu.pres','dateset')">$lt{'ssd'}</a></td>
<td><input type=hidden name="end_$protectedcourse\_$role" value=''>
<a href=
"javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$role.value,'end_$protectedcourse\_$role','cu.pres','dateset')">$lt{'sed'}</a></td>
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().
'<td><input type="checkbox" name="act_'.$customrole.'"></td>
<td>'.$plrole.'</td>
<td>'.$area.'</td>'."\n";
                if (%sections_count) {
                    my $currsec = &course_sections(\%sections_count,$customrole);
                    $table.=
                   '<td><table border="0" cellspacing="0" cellpadding="0">'.
                   '<tr><td valign="top">'.$lt{'exs'}.'<br />'.
                     $currsec.'</td>'.
                   '<td>&nbsp;&nbsp;</td>'.
                   '<td valign="top">&nbsp;'.$lt{'new'}.'<br />'.
                   '<input type="text" name="newsec_'.$customrole.'" value="" /></td>'.
                   '<input type="hidden" '.
                   'name="sec_'.$customrole.'"></td>'.
                   '</tr></table></td>';
                } else {
                    $table .= '<td><input type="text" size="10" '.
                     'name="sec_'.$customrole.'"></td>';
                }
                $table .= <<ENDENTRY;
<td><input type=hidden name="start_$customrole" value=''>
<a href=
"javascript:pjump('date_start','Start Date $plrole',document.cu.start_$customrole.value,'start_$customrole','cu.pres','dateset')">$lt{'ssd'}</a></td>
<td><input type=hidden name="end_$customrole" value=''>
<a href=
"javascript:pjump('date_end','End Date $plrole',document.cu.end_$customrole.value,'end_$customrole','cu.pres','dateset')">$lt{'sed'}</a></td>
ENDENTRY
               $table .= &Apache::loncommon::end_data_table_row();
           }
	}
    }
    return '' if ($table eq ''); # return nothing if there is nothing 
                                 # in the table
    my $result = '
<h4>'.$lt{'crl'}.'</h4>'.
&Apache::loncommon::start_data_table().
&Apache::loncommon::start_data_table_header_row().
'<th>'.$lt{'act'}.'</th><th>'.$lt{'rol'}.'</th><th>'.$lt{'ext'}.'</th>
<th>'.$lt{'grs'}.'</th><th>'.$lt{'sta'}.'</th><th>'.$lt{'end'}.'</th>'.
&Apache::loncommon::end_data_table_header_row().
&Apache::loncommon::start_data_table_row().
$table.
&Apache::loncommon::end_data_table_row().
&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 = '<select name="currsec_'.$role.'" >'."\n".
                  '  <option value="">Select</option>'."\n".
                  '  <option value="">No section</option>'."\n".
                  '  <option value="'.$sections[0].'" >'.$sections[0].'</option>'."\n";
    } else {
        $output = '<select name="currsec_'.$role.'" ';
        my $multiple = 4;
        if (scalar(@sections) < 4) { $multiple = scalar(@sections); }
        $output .= 'multiple="multiple" size="'.$multiple.'">'."\n";
        foreach my $sec (@sections) {
            $output .= '<option value="'.$sec.'">'.$sec."</option>\n";
        }
    }
    $output .= '</select>'; 
    return $output;
}

sub course_level_dc {
    my ($dcdom) = @_;
    my %customroles=&my_custom_roles();
    my $hiddenitems = '<input type="hidden" name="dcdomain" value="'.$dcdom.'" />'.
                      '<input type="hidden" name="origdom" value="'.$dcdom.'" />'.
                      '<input type="hidden" name="dccourse" value="" />';
    my $courseform='<b>'.&Apache::loncommon::selectcourse_link
            ('cu','dccourse','dcdomain','coursedesc',undef,undef,'Course').'</b>';
    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 = '<h4>'.&mt('Course Level').'</h4>'.
                 &Apache::loncommon::start_data_table().
                 &Apache::loncommon::start_data_table_header_row().
                 '<th>'.$courseform.'</th><th>'.$lt{'rol'}.'</th><th>'.$lt{'grs'}.'</th><th>'.$lt{'sta'}.'</th><th>'.$lt{'end'}.'</th>'.
                 &Apache::loncommon::end_data_table_header_row();
    my $otheritems = &Apache::loncommon::start_data_table_row()."\n".
                     '<td><input type="text" name="coursedesc" value="" onFocus="this.blur();opencrsbrowser('."'cu','dccourse','dcdomain','coursedesc',''".')" /></td>'."\n".
                     '<td><select name="role">'."\n";
    foreach  my $role ('st','ta','ep','in','cc') {
        my $plrole=&Apache::lonnet::plaintext($role);
        $otheritems .= '  <option value="'.$role.'">'.$plrole;
    }
    if ( keys %customroles > 0) {
        foreach my $cust (sort keys %customroles) {
            my $custrole='cr_cr_'.$env{'user.domain'}.
                    '_'.$env{'user.name'}.'_'.$cust;
            $otheritems .= '  <option value="'.$custrole.'">'.$cust;
        }
    }
    $otheritems .= '</select></td><td>'.
                     '<table border="0" cellspacing="0" cellpadding="0">'.
                     '<tr><td valign="top"><b>'.$lt{'exs'}.'</b><br /><select name="currsec">'.
                     ' <option value=""><--'.&mt('Pick course first').'</select></td>'.
                     '<td>&nbsp;&nbsp;</td>'.
                     '<td valign="top">&nbsp;<b>'.$lt{'new'}.'</b><br />'.
                     '<input type="text" name="newsec" value="" />'.
                     '<input type="hidden" name="groups" value="" /></td>'.
                     '</tr></table></td>';
    $otheritems .= <<ENDTIMEENTRY;
<td><input type=hidden name="start" value=''>
<a href=
"javascript:pjump('date_start','Start Date',document.cu.start.value,'start','cu.pres','dateset')">$lt{'ssd'}</a></td>
<td><input type=hidden name="end" value=''>
<a href=
"javascript:pjump('date_end','End Date',document.cu.end.value,'end','cu.pres','dateset')">$lt{'sed'}</a></td>
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__