Diff for /loncom/interface/loncreateuser.pm between versions 1.11 and 1.174

version 1.11, 2001/03/24 17:25:54 version 1.174, 2007/08/16 21:36:13
Line 1 Line 1
 # The LearningOnline Network  # The LearningOnline Network with CAPA
 # Create a user  # Create a user
 #  #
 # (Create a course  # $Id$
 # (My Desk  
 #  #
 # (Internal Server Error Handler  # Copyright Michigan State University Board of Trustees
 #  #
 # (Login Screen  # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
 # 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)  
 #  #
 # 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,2/17,2/19,2/20,2/21,2/22,2/23,3/2,3/17,3/24 Gerd Kortemeyer  # /home/httpd/html/adm/gpl.txt
 #  #
   # http://www.lon-capa.org/
   #
   ###
   
 package Apache::loncreateuser;  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 strict;
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
 use Apache::lonnet;  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";
   <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  # =================================================================== Phase one
   
 sub phase_one {  sub print_username_entry_form {
     my $r=shift;      my ($r,$response,$srch,$forcenewuser) = @_;
     my $defdom=$ENV{'user.domain'};      my $defdom=$env{'request.role.domain'};
     $r->print(<<ENDDOCUMENT);      my $formtoset = 'crtuser';
 <html>      if (exists($env{'form.startrolename'})) {
 <head>          $formtoset = 'docustom';
 <title>The LearningOnline Network with CAPA</title>          $env{'form.rolename'} = $env{'form.startrolename'};
 </head>      }
 <body bgcolor="#FFFFFF">  
 <h1>Create User, Change User Privileges</h1>      my ($jsback,$elements) = &crumb_utilities();
 <form action=/adm/createuser method=post>  
 <input type=hidden name=phase value=two>      my $jscript = &Apache::loncommon::studentbrowser_javascript()."\n".
 Username: <input type=text size=15 name=ccuname><br>          '<script type="text/javascript">'."\n".
 Domain: <input type=text size=15 name=ccdomain value=$defdom><p>          &Apache::lonhtmlcommon::set_form_elements($elements->{$formtoset}).
 <input type=submit value="Continue">          '</script>'."\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
   <h2>$lt{siur}$helpsiur</h2>
   <h3>$lt{'srch'} $sellink $lt{'mod'}</h3>
   $response");
       $r->print(&entry_form($defdom,$srch,$forcenewuser));
       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>  </form>
 </body>  ENDCUSTOM
 </html>      }
 ENDDOCUMENT      $r->print(&Apache::loncommon::end_page());
 }  }
   
 # =================================================================== Phase two  sub entry_form {
       my ($dom,$srch,$forcenewuser) = @_;
       my $userpicker = 
          &Apache::loncommon::user_picker($dom,$srch,$forcenewuser);
       my $srchbutton = &mt('Search');
       my $output = <<"ENDDOCUMENT";
   <form action="/adm/createuser" method="post" name="crtuser">
   <input type="hidden" name="phase" value="get_user_info" />
   $userpicker
   <input name="userrole" type="button" value="$srchbutton" onclick="javascript:validateEntry()" />
   </form>
   ENDDOCUMENT
       return $output;
   }
   
 sub phase_two {  sub user_modification_js {
     my $r=shift;      my ($pjump_def,$dc_setcourse_code,$nondc_setsection_code,$groupslist)=@_;
     my $ccuname=$ENV{'form.ccuname'};      
     my $ccdomain=$ENV{'form.ccdomain'};      return <<END;
   <script type="text/javascript" language="Javascript">
     $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;  
     my $krbdefdom=$1;  
     $krbdefdom=~tr/a-z/A-Z/;  
   
     my $defdom=$ENV{'user.domain'};  
   
     $ccuname=~s/\W//g;  
     $ccdomain=~s/\W//g;  
     $r->print(<<ENDENHEAD);  
 <html>  
 <head>  
 <title>The LearningOnline Network with CAPA</title>  
 <script>  
   
     function pclose() {      function pclose() {
         parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",          parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
Line 74  sub phase_two { Line 288  sub phase_two {
         parmwin.close();          parmwin.close();
     }      }
   
     function pjump(type,dis,value,marker,ret,call) {      $pjump_def
         parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)      $dc_setcourse_code
                  +"&value="+escape(value)+"&marker="+escape(marker)  
                  +"&return="+escape(ret)  
                  +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",  
                  "height=350,width=350,scrollbars=no,menubar=no");  
   
     }  
   
     function dateset() {      function dateset() {
         eval("document.cu."+document.cu.pres_marker.value+          eval("document.cu."+document.cu.pres_marker.value+
Line 89  sub phase_two { Line 297  sub phase_two {
         pclose();          pclose();
     }      }
   
 </script>      $nondc_setsection_code
 </head>  
 <body bgcolor="#FFFFFF">  
 <img align=right src=/adm/lonIcons/lonlogos.gif>  
 <h1>Create User, Change User Privileges</h1>  
 <form action=/adm/createuser method=post name=cu>  
 <input type=hidden name=phase value=three>  
 <input type=hidden name=ccuname value=$ccuname>  
 <input type=hidden name=ccdomain value=$ccdomain>  
 <input type="hidden" value='' name="pres_value">  
 <input type="hidden" value='' name="pres_type">  
 <input type="hidden" value='' name="pres_marker">  
 <input type=hidden name=cuname value="$ccuname">  
 <input type=hidden name=cdomain value="$ccdomain">  
   
 ENDENHEAD  </script>
     my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);  END
     my %incdomains;   
     my %inccourses;  
     $incdomains{$ENV{'user.domain'}}=1;  
     map {  
  if ($_=~/^user\.priv\.cm\.\/(\w+)\/(\w+)/) {  
     $inccourses{$1.'_'.$2}=1;  
         }  
     } %ENV;  
     if ($uhome eq 'no_host') {  
  $r->print(<<ENDNUSER);  
 <h2>New user $ccuname at $ccdomain</h2>  
 <script>  
 function setkrb(vf) {  
     if (vf.krbdom.value!='') {  
        vf.login[0].checked=true;  
        vf.krbdom.value=vf.krbdom.value.toUpperCase();  
        vf.intpwd.value='';  
    }  
 }  }
   
 function setint(vf) {  # =================================================================== Phase two
     if (vf.intpwd.value!='') {  sub print_user_selection_page {
        vf.login[1].checked=true;      my ($r,$response,$srch,$srch_results) = @_;
        vf.krbdom.value='';      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 = (<<ENDSCRIPT);
   <script type="text/javascript">
   function pickuser(uname,udom) {
       document.usersrchform.seluname.value=uname;
       document.usersrchform.seludom.value=udom;
       document.usersrchform.phase.value="userpicked";
       document.usersrchform.submit();
 }  }
   
 function clickkrb(vf) {  $jsback
     vf.krbdom.value='$krbdefdom';  </script>
     vf.intpwd.value='';  ENDSCRIPT
   
       my %lt=&Apache::lonlocal::texthash(
                                          'srch'           => "User Search to add/modify roles",
                                          'username'       => "username",
                                          'domain'         => "domain",
                                          'lastname'       => "last name",
                                          'firstname'      => "first name",
                                          'permanentemail' => "permanent e-mail",
                                         );
       $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("<b>$lt{'srch'}</b><br />");
       $r->print(&entry_form($srch->{'srchdomain'},$srch));
       $r->print('<h3>'.&mt('Select a user to add/modify roles').'</h3>');
       $r->print('<form name="usersrchform" method="post">'.
                 &Apache::loncommon::start_data_table()."\n".
                 &Apache::loncommon::start_data_table_header_row()."\n".
                 ' <th> </th>'."\n");
       foreach my $field (@fields) {
           $r->print(' <th><a href="javascript:document.usersrchform.sortby.value='.
                     "'".$field."'".';document.usersrchform.submit();">'.
                     $lt{$field}.'</a></th>'."\n");
       }
       $r->print(&Apache::loncommon::end_data_table_header_row());
   
       my @sorted_users = sort {
           lc($srch_results->{$a}->{$sortby})   cmp lc($srch_results->{$b}->{$sortby})
               ||
           lc($srch_results->{$a}->{lastname})  cmp lc($srch_results->{$b}->{lastname})
               ||
           lc($srch_results->{$a}->{firstname}) cmp lc($srch_results->{$b}->{firstname})
       ||
    lc($a) cmp lc($b)
           } (keys(%$srch_results));
   
       foreach my $user (@sorted_users) {
           my ($uname,$udom) = split(/:/,$user);
           $r->print(&Apache::loncommon::start_data_table_row().
                     '<td><input type="button" name="seluser" value="'.&mt('Select').'" onclick="javascript:pickuser('."'".$uname."'".','."'".$udom."'".')" /></td>'.
                     '<td><tt>'.$uname.'</tt></td>'.
                     '<td><tt>'.$udom.'</tt></td>');
           foreach my $field ('lastname','firstname','permanentemail') {
               $r->print('<td>'.$srch_results->{$user}->{$field}.'</td>');
           }
           $r->print(&Apache::loncommon::end_data_table_row());
       }
       $r->print(&Apache::loncommon::end_data_table().'<br /><br />');
       $r->print(&Apache::lonhtmlcommon::echo_form_input(['sortby','seluname','seludom','state','phase']));
       $r->print(' <input type="hidden" name="sortby" value="'.$sortby.'" />'."\n".
                 ' <input type="hidden" name="seluname" value="" />'."\n".
                 ' <input type="hidden" name="seludom" value="" />'."\n".
                 ' <input type="hidden" name="state" value="select" />'."\n".
                 ' <input type="hidden" name="phase" value="get_user_info" />'."\n".
                 '</form>');
       $r->print($response);
       $r->print(&Apache::loncommon::end_page());
 }  }
   
 function clickint(vf) {  sub print_user_query_page {
     vf.krbdom.value='';      my ($r) = @_;
   # FIXME - this is for a network-wide name search (similar to catalog search)
   # To use frames with similar behavior to catalog/portfolio search.
   # To be implemented. 
       return;
 }  }
   
   sub print_user_modification_page {
       my ($r,$ccuname,$ccdomain,$srch,$response) = @_;
       unless (($ccuname) && ($ccdomain)) {
    &print_username_entry_form($r);
           return;
       }
       if ($response) {
           $response = '<br />'.$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<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 match = str.split('_');
                       var role = match[3];
                       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 ($jsback,$elements) = &crumb_utilities();
   
       $js .= "\n".
              '<script type="text/javascript">'."\n".$jsback."\n".'</script>';
   
       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";
   <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 $newuser;
           my $instsrch = {
                            srchin => 'instd',
                            srchby => 'uname',
                            srchtype => 'exact',
                          };
           if ($env{'form.phase'} eq 'userpicked') {
               $instsrch->{'srchterm'} = $env{'form.seluname'};
               $instsrch->{'srchdomain'} = $env{'form.seludom'};
           } else {
               $instsrch->{'srchterm'} = $ccuname;
               $instsrch->{'srchdomain'} = $ccdomain,
           }
           if (($instsrch->{'srchterm'} ne '') && ($instsrch->{'srchdomain'} ne '')) {
               $newuser = $instsrch->{'srchterm'}.':'.$instsrch->{'srchdomain'};
           }
           my (%dirsrch_results,%inst_results);
           if ($newuser) {
               if (&directorysrch_check($instsrch) eq 'ok') {
                   %dirsrch_results = &Apache::lonnet::inst_directory_query($instsrch);
                   if (ref($dirsrch_results{$newuser}) eq 'HASH') { 
                       %inst_results = %{$dirsrch_results{$newuser}};
                   }
               }
           }
           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",
                       'mail' => "Permanent e-mail address",
                       'idsn' => "ID/Student Number",
                       'hs'   => "Home Server",
                       'lg'   => "Login Data"
          );
           my $portfolioform;
           if (&Apache::lonnet::allowed('mpq',$env{'request.role.domain'})) {
               # Current user has quota modification privileges
               $portfolioform = &portfolio_quota($ccuname,$ccdomain);
           }
    my $genhelp=&Apache::loncommon::help_open_topic('Generation');
           &initialize_authen_forms();
    $r->print(<<ENDNEWUSER);
   $start_page
   $crumbs
   <h1>$lt{'cnu'}</h1>
   $response
   $forminfo
   <h2>$lt{'nu'} "$ccuname" $lt{'id'} $ccdomain</h2>
   <script type="text/javascript" language="Javascript">
   $loginscript
 </script>  </script>
 <input type=hidden name=makeuser value=1>  <input type='hidden' name='makeuser' value='1' />
 <h3>Personal Data</h3>  <h3>$lt{'pd'}</h3>
 First Name: <input type=text name=cfirst size=15><br>  <p>
 Middle Name: <input type=text name=cmiddle size=15><br>  <table>
 Last Name: <input type=text name=clast size=15><br>  <tr><td>$lt{'fn'}  </td>
 Generation: <input type=text name=cgen size=5><p>      <td><input type="text" name="cfirst" size="15" value="$inst_results{'firstname'}" /></td></tr>
   <tr><td>$lt{'mn'} </td> 
 ID/Student Number: <input type=text name=cstid size=10><p>      <td><input type="text" name="cmiddle" size="15" value="$inst_results{'middlename'}" /></td></tr>
   <tr><td>$lt{'ln'}   </td>
 <h3>Login Data</h3>      <td><input type="text" name="clast" size="15" value="$inst_results{'lastname'}" /></td></tr>
 <input type=radio name=login value=krb onClick="clickkrb(this.form);">  <tr><td>$lt{'gen'}$genhelp</td>
 Kerberos authenticated with domain      <td><input type="text" name="cgen" size="5" value="$inst_results{'generation'}" /></td></tr>
 <input type=text size=10 name=krbdom onChange="setkrb(this.form);"><p>  <tr><td>$lt{'mail'}</td>
 <input type=radio name=login value=int onClick="clickint(this.form);">       <td><input type="text" name="cemail" size="20" value="$inst_results{'permanentemail'}" /></td></tr>
 Internally authenticated (with initial password   </table>
 <input type=text size=10 name=intpwd onChange="setint(this.form);">)  $lt{'idsn'} <input type="text" name="cstid" size="15" value="$inst_results{'id'}" /></p>
 ENDNUSER  $lt{'hs'}: <select name="hserver" size="1"> $home_server_list </select>
     } else {  <hr />
  $r->print('<h2>Existing user '.$ccuname.' at '.$ccdomain.'</h2>');  <h3>$lt{'lg'}</h3>
   <p>$generalrule </p>
         my $rolesdump=&Apache::lonnet::reply(  <p>$authformkrb </p>
                                   "dump:$ccdomain:$ccuname:roles",$uhome);  <p>$authformint </p>
         unless ($rolesdump eq 'con_lost') {   <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",
                       'email' => "permanent e-mail",
          );
    $r->print(<<ENDCHANGEUSER);
   $start_page
   $crumbs
   <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',
                    'permanentemail','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><th>'.$lt{'email'}.'</th>'.
                     &Apache::loncommon::end_data_table_header_row().
                     &Apache::loncommon::start_data_table_row());
           foreach my $item ('firstname','middlename','lastname','generation','permanentemail') {
              if (&Apache::lonnet::allowed('mau',$ccdomain)) {
                 $r->print(<<"END");
   <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 $now=time;
            $r->print('<h4>Revoke Existing Roles</h4>'.     my %lt=&Apache::lonlocal::texthash(
              '<table border=2><tr><th>Revoke</th><th>Role</th><th>Extent</th>'.      'rer'  => "Revoke Existing Roles",
      '<th>Start</th><th>End</th>');                      'rev'  => "Revoke",                    
            map {                      'del'  => "Delete",
              if ($_!~/^rolesdef\&/) {      'ren'  => "Re-Enable",
                       'rol'  => "Role",
               my ($area,$role)=split(/=/,$_);                      'ext'  => "Extent",
               my $thisrole=$area;                      'sta'  => "Start",
               $area=~s/\_\w\w$//;                      'end'  => "End"
               my ($trole,$tend,$tstart)=split(/_/,$role);         );
               my $bgcol='ffffff';             my (%roletext,%sortrole,%roleclass,%rolepriv);
               my $allows=0;     foreach my $area (sort { my $a1=join('_',(split('_',$a))[1,0]);
               if ($area=~/^\/(\w+)\/(\d\w+)/) {      my $b1=join('_',(split('_',$b))[1,0]);
                  my %coursedata=&Apache::lonnet::coursedescription($1.'_'.$2);      return $a1 cmp $b1;
                  my $carea='Course: '.$coursedata{'description'};   } keys(%rolesdump)) {
                  $inccourses{$1.'_'.$2}=1;                 next if ($area =~ /^rolesdef/);
                  if (&Apache::lonnet::allowed('c'.$trole,$1.'/'.$2)) {         my $envkey=$area;
      $allows=1;                 my $role = $rolesdump{$area};
                  }                 my $thisrole=$area;
                  $bgcol=$1.'_'.$2;                 $area =~ s/\_\w\w$//;
                  $bgcol=~s/[^8-9b-e]//g;                 my ($role_code,$role_end_time,$role_start_time) = 
                  $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);                     split(/_/,$role);
                  if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {  # Is this a custom role? Get role owner and title.
                      $carea.='<br>Section/Group: '.$3;         my ($croleudom,$croleuname,$croletitle)=
  }             ($role_code=~m{^cr/($match_domain)/($match_username)/(\w+)$});
                  $area=$carea;                 my $allowed=0;
       } else {                 my $delallowed=0;
                  if ($area=~/^\/(\w+)\//) {         my $sortkey=$role_code;
      $incdomains{$1}=1;         my $class='Unknown';
                      if (&Apache::lonnet::allowed('c'.$trole,$1)) {                 if ($area =~ m{^/($match_domain)/($match_courseid)} ) {
  $allows=1;     $class='Course';
                      }                     my ($coursedom,$coursedir) = ($1,$2);
                  } else {     $sortkey.="\0$coursedom";
                      if (&Apache::lonnet::allowed('c'.$trole,'/')) {                     # $1.'_'.$2 is the course id (eg. 103_12345abcef103l3).
  $allows=1;                     my %coursedata=
                      }                         &Apache::lonnet::coursedescription($1.'_'.$2);
                  }     my $carea;
       }     if (defined($coursedata{'description'})) {
          $carea=$coursedata{'description'}.
               my $active=1;                             '<br />'.&mt('Domain').': '.$coursedom.('&nbsp;'x8).
               if (($tend) && ($now>$tend)) { $active=0; }       &Apache::loncommon::syllabuswrapper('Syllabus',$coursedir,$coursedom);
          $sortkey.="\0".$coursedata{'description'};
               $r->print('<tr bgcolor=#'.$bgcol.'><td>');                         $class=$coursedata{'type'};
               if ($active) {     } else {
                   if ($allows) {         $carea=&mt('Unavailable course').': '.$area;
      $r->print(         $sortkey.="\0".&mt('Unavailable course').': '.$area;
                              '<input type=checkbox name="rev:'.$thisrole.'">');     }
  } else {     $sortkey.="\0$coursedir";
                      $r->print('&nbsp;');                     $inccourses{$1.'_'.$2}=1;
                  }                     if ((&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) ||
               } else {                         (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
                   $r->print('&nbsp;');                         $allowed=1;
               }                     }
               $r->print('</td><td>'.&Apache::lonnet::plaintext($trole).                     if ((&Apache::lonnet::allowed('dro',$1)) ||
                         '</td><td>'.$area.'</td><td>'.                         (&Apache::lonnet::allowed('dro',$ccdomain))) {
                         ($tstart?localtime($tstart):'&nbsp;').'</td><td>'.                         $delallowed=1;
                         ($tend?localtime($tend):'&nbsp;')."</td></tr>\n");                     }
      }  # - custom role. Needs more info, too
    } split(/&/,$rolesdump);     if ($croletitle) {
    $r->print('</table>');         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='';
          if (!$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());
     }      }
     $r->print('<hr><h3>Add Roles</h3><h4>System Level</h4>');  
 #  #
 # Domain level  # Domain level
 #  #
     $r->print('<h4>Domain Level</h4>'.      my $num_domain_level = 0;
     '<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>'.      my $domaintext = 
     '<th>Start</th><th>End</th></tr>');      '<h4>'.&mt('Domain Level').'</h4>'.
     map {      &Apache::loncommon::start_data_table().
  my $thisdomain=$_;      &Apache::loncommon::start_data_table_header_row().
         map {      '<th>'.&mt('Activate').'</th><th>'.&mt('Role').'</th><th>'.
             if (&Apache::lonnet::allowed('c'.$_,$thisdomain)) {      &mt('Extent').'</th>'.
                my $plrole=&Apache::lonnet::plaintext($_);      '<th>'.&mt('Start').'</th><th>'.&mt('End').'</th>'.
                $r->print(<<ENDDROW);      &Apache::loncommon::end_data_table_header_row();
 <tr>      foreach my $thisdomain (sort(&Apache::lonnet::all_domains())) {
 <td><input type=checkbox name="act_$thisdomain\_$_"></td>          foreach my $role ('dc','li','dg','au','sc') {
 <td>$plrole</td>              if (&Apache::lonnet::allowed('c'.$role,$thisdomain)) {
 <td>$thisdomain</td>                 my $plrole=&Apache::lonnet::plaintext($role);
 <td><input type=hidden name="start_$thisdomain\_$_" value=''>         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=  <a href=
 "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$thisdomain\_$_.value,'start_$thisdomain\_$_','cu.pres','dateset')">Set Start Date</a></td>  "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\_$_" value=''>  <td><input type="hidden" name="end_'.$thisdomain.'_'.$role.'" value="" />
 <a href=  <a href=
 "javascript:pjump('date_end','End Date $plrole',document.cu.end_$thisdomain\_$_.value,'end_$thisdomain\_$_','cu.pres','dateset')">Set End Date</a></td>  "javascript:pjump('."'date_end','End Date $plrole',document.cu.end_$thisdomain\_$role.value,'end_$thisdomain\_$role','cu.pres','dateset'".')">'.$lt{'sed'}.'</a></td>'.
 </tr>  &Apache::loncommon::end_data_table_row();
 ENDDROW  
             }              }
         } ('dc','cc','li','dg','au');          } 
     } sort keys %incdomains;      }
     $r->print('</table>');      $domaintext.= &Apache::loncommon::end_data_table();
 #      if ($num_domain_level > 0) {
 # Course level          $r->print($domaintext);
 #      }
     $r->print('<h4>Course Level</h4>'.  #
     '<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>'.  # Course and group levels
     '<th>Group/Section</th><th>Start</th><th>End</th></tr>');  #
     map {  
  my $thiscourse=$_;  
         my %coursedata=&Apache::lonnet::coursedescription($thiscourse);  
         my $area=$coursedata{'description'};  
         my $bgcol=$thiscourse;  
         $bgcol=~s/[^8-9b-e]//g;  
         $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);  
         map {  
             if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) {  
                my $plrole=&Apache::lonnet::plaintext($_);  
                $r->print(<<ENDROW);  
 <tr bgcolor=#$bgcol>  
 <td><input type=checkbox name="act_$thiscourse\_$_"></td>  
 <td>$plrole</td>  
 <td>$area</td>  
 <td><input type=text size=5 name="sec_$thiscourse\_$_"></td>  
 <td><input type=hidden name="start_$thiscourse\_$_" value=''>  
 <a href=  
 "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$thiscourse\_$_.value,'start_$thiscourse\_$_','cu.pres','dateset')">Set Start Date</a></td>  
 <td><input type=hidden name="end_$thiscourse\_$_" value=''>  
 <a href=  
 "javascript:pjump('date_end','End Date $plrole',document.cu.end_$thiscourse\_$_.value,'end_$thiscourse\_$_','cu.pres','dateset')">Set End Date</a></td>  
 </tr>  
 ENDROW  
   
             }      if ($env{'request.role'} =~ m{^dc\./($match_domain)/$}) {
         } ('st','ta','ep','ad','in');          $r->print(&course_level_dc($1,'Course'));
     } sort keys %inccourses;          $r->print('<hr /><input type="button" value="'.&mt('Modify User').'" onClick="setCourse()" />'."\n");
     $r->print('</table>');      } else {
     $r->print('<input type=submit value="Modify User">');          $r->print(&course_level_table(%inccourses));
     $r->print('</form></body></html>');          $r->print('<hr /><input type="button" value="'.&mt('Modify User').'" onClick="setSections()" />'."\n");
       }
       $r->print(&Apache::lonhtmlcommon::echo_form_input(['phase','userrole','ccdomain','prevphase','state']));
       $r->print('<input type="hidden" name="state" value="" />');
       $r->print('<input type="hidden" name="prevphase" value="'.$env{'form.phase'}.'" />');
       $r->print("</form>".&Apache::loncommon::end_page());
 }  }
   
 # ================================================================= Phase Three  # ================================================================= Phase Three
   sub update_user_data {
       my ($r) = @_; 
       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';
       }
   
       my ($jsback,$elements) = &crumb_utilities();
       my $jscript = '<script type="text/javascript">'."\n".
                     $jsback."\n".'</script>'."\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;
       }
   
 sub phase_three {  
     my $r=shift;  
     $r->print(<<ENDTHREEHEAD);  
 <html>  
 <head>  
 <title>The LearningOnline Network with CAPA</title>  
 </head>  
 <body bgcolor="#FFFFFF">  
 <img align=right src=/adm/lonIcons/lonlogos.gif>  
 <h1>Create User, Change User Privileges</h1>  
 ENDTHREEHEAD  
    $r->print('<h2>'.$ENV{'form.cuname'}.' at '.$ENV{'form.cdomain'}.'</h2>');  
    if ($ENV{'form.makeuser'}) {  
     $r->print('<h3>Creating User</h3>');  
     if (($ENV{'form.cuname'})&&($ENV{'form.cuname'}!~/\W/)&&  
         ($ENV{'form.cdomain'})&&($ENV{'form.cdomain'}!~/\W/)) {  
  my $amode='';  
         my $genpwd='';  
         if ($ENV{'form.login'} eq 'krb') {  
            $amode='krb4';  
            $genpwd=$ENV{'form.krbdom'};  
         } elsif ($ENV{'form.login'} eq 'int') {  
            $amode='internal';  
            $genpwd=$ENV{'form.intpwd'};  
         }  
         if (($amode) && ($genpwd)) {  
           $r->print('Generating user: '.&Apache::lonnet::modifyuser(  
                       $ENV{'form.cdomain'},$ENV{'form.cuname'},  
                       $ENV{'form.cstid'},$amode,$genpwd,  
                $ENV{'form.cfirst'},$ENV{'form.cmiddle'},  
                       $ENV{'form.clast'},$ENV{'form.cgen'}));  
           $r->print('<br>Home server: '.&Apache::lonnet::homeserver  
                       ($ENV{'form.cuname'},$ENV{'form.cdomain'}));  
   
       $r->print('<h2>'.&mt('User [_1] in domain [_2]',
    $env{'form.ccuname'}, $env{'form.ccdomain'}).'</h2>');
   
       if ($env{'form.makeuser'}) {
    $r->print('<h3>'.&mt('Creating new account.').'</h3>');
           # 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
           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 {   } else {
            $r->print('Invalid login mode or password');          # Okay, this is a non-fatal error.
         }                $r->print($error.&mt('You do not have the authority to modify this users authentification information').'.');    
     } else {   }
         $r->print('Invalid username or domain');  
     }      }
    }      ##
       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 = &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'} ||
                $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");
   <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{'mail'}</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>$userenv{'permanentemail'} </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>$env{'form.cpermanentemail'} </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(
                              'mail' => "Permanent e-mail",
                              'disk' => "Disk space allocated to user's portfolio files",
          );
               $r->print(<<"END");
   <h4>$userenv{'firstname'} $userenv{'middlename'} $userenv{'lastname'} $userenv{'generation'}</h4>
   <h4>$lt{'mail'}: $userenv{'permanentemail'}</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;      my $now=time;
     $r->print('<h3>Modifying Roles</h3>');      $r->print('<h3>'.&mt('Modifying Roles').'</h3>');
     map {      foreach my $key (keys (%env)) {
  if (($_=~/^form\.rev\:([^\_]+)\_([^\_]+)$/) && ($ENV{$_})) {   next if (! $env{$key});
            $r->print('Revoking '.$2.' in '.$1.': '.   # Revoke roles
           &Apache::lonnet::assignrole($ENV{'form.cdomain'},$ENV{'form.cuname'},   if ($key=~/^form\.rev/) {
                                       $1,$2,$now).'<br>');      if ($key=~/^form\.rev\:([^\_]+)\_([^\_\.]+)$/) {
            if ($2 eq 'st') {  # Revoke standard role
                $1=~/^\/(\w+)\/(\w+)/;   my ($scope,$role) = ($1,$2);
                my $cid=$1.'_'.$2;   my $result =
        $r->print('Drop from classlist: '.      &Apache::lonnet::revokerole($env{'form.ccdomain'},
           &Apache::lonnet::critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.   $env{'form.ccuname'},
               $ENV{'course.'.$cid.'.num'}.':classlist:'.   $scope,$role);
                       &Apache::lonnet::escape($ENV{'form.cuname'}.':'.          $r->print(&mt('Revoking [_1] in [_2]: [_3]',
                                               $ENV{'form.cdomain'}).'='.        $role,$scope,'<b>'.$result.'</b>').'<br />');
                       &Apache::lonnet::escape($now.':'),   if ($role eq 'st') {
               $ENV{'course.'.$cid.'.home'}).'<br>');      my $result = &classlist_drop($scope,$env{'form.ccuname'},
            }   $env{'form.ccdomain'},$now);
  }      $r->print($result);
     } keys %ENV;   }
     map {      } 
  if (($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_([^\_]+)$/) && ($ENV{$_})) {      if ($key=~m{^form\.rev\:([^_]+)_cr\.cr/($match_domain)/($match_username)/(\w+)$ }s) {
             my $url='/'.$1.'/'.$2;  # Revoke custom role
             if ($ENV{'form.sec_'.$1.'_'.$2.'_'.$3}) {   $r->print(&mt('Revoking custom role:').
  $url.='/'.$ENV{'form.sec_'.$1.'_'.$2.'_'.$3};                        ' '.$4.' by '.$3.':'.$2.' in '.$1.': <b>'.
             }                        &Apache::lonnet::revokecustomrole($env{'form.ccdomain'},
             my $start=$now;    $env{'form.ccuname'},$1,$2,$3,$4).
             if ($ENV{'form.start_'.$1.'_'.$2.'_'.$3}) {   '</b><br />');
  $start=$ENV{'form.start_'.$1.'_'.$2.'_'.$3};  
             }  
             my $end=0;  
             if ($ENV{'form.end_'.$1.'_'.$2.'_'.$3}) {  
  $end=$ENV{'form.end_'.$1.'_'.$2.'_'.$3};  
             }  
             $r->print('Assigning: '.$3.' in '.$url.': '.  
           &Apache::lonnet::assignrole($ENV{'form.cdomain'},$ENV{'form.cuname'},  
                                       $url,$3,$end,$start).'<br>');  
             if ($3 eq 'st') {  
  $url=~/^\/(\w+)\/(\w+)/;  
                 my $cid=$1.'_'.$2;  
                $r->print('Add to classlist: '.  
           &Apache::lonnet::critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.  
               $ENV{'course.'.$cid.'.num'}.':classlist:'.  
                       &Apache::lonnet::escape($ENV{'form.cuname'}.':'.  
                                               $ENV{'form.cdomain'}).'='.  
                       &Apache::lonnet::escape($end.':'.$start),  
               $ENV{'course.'.$cid.'.home'}).'<br>');  
     }      }
  } elsif (($_=~/^form\.act\_([^\_]+)\_([^\_]+)$/) && ($ENV{$_})) {   } elsif ($key=~/^form\.del/) {
             my $url='/'.$1.'/';      if ($key=~/^form\.del\:([^\_]+)\_([^\_\.]+)$/) {
             my $start=$now;  # Delete standard role
             if ($ENV{'form.start_'.$1.'_'.$2}) {   my ($scope,$role) = ($1,$2);
  $start=$ENV{'form.start_'.$1.'_'.$2};   my $result =
             }      &Apache::lonnet::assignrole($env{'form.ccdomain'},
             my $end=0;   $env{'form.ccuname'},
             if ($ENV{'form.end_'.$1.'_'.$2}) {   $scope,$role,$now,0,1);
  $end=$ENV{'form.end_'.$1.'_'.$2};          $r->print(&mt('Deleting [_1] in [_2]: [_3]',$role,$scope,
             }        '<b>'.$result.'</b>').'<br />');
             $r->print('Assigning: '.$2.' in '.$url.': '.   if ($role eq 'st') {
           &Apache::lonnet::assignrole($ENV{'form.cdomain'},$ENV{'form.cuname'},      my $result = &classlist_drop($scope,$env{'form.ccuname'},
                                       $url,$2,$end,$start).'<br>');   $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).': <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">'.&mt('Create/Modify Another User').'</a></p>');
       $r->print('<form name="userupdate" method="post" />'."\n");
       foreach my $item ('srchby','srchin','srchtype','srchterm','srchdomain','ccuname','ccdomain') {
           $r->print('<input type="hidden" name="'.$item.'" value="'.$env{'form.'.$item}.'" />'."\n");
       }
       foreach my $item ('sortby','seluname','seludom') {
           if (exists($env{'form.'.$item})) {
               $r->print('<input type="hidden" name="'.$item.'" value="'.$env{'form.'.$item}.'" />'."\n");
           }
       }
       $r->print('<input type="hidden" name="phase" value="" />'."\n".
                 '<input type ="hidden" name="state" value="" />'."\n".
                 '</form>');
       $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]',
      '<b>'.$result.'</b>').'<br />';
       }
   }
   
   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 ++;
         }          }
     } keys %ENV;      }
     $r->print('</body></html>');  
       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 .= '<h2>';
       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.'"</h2>';
       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 .= '<script type="text/javascript">'."\n";
       my @template_roles = ("cc","in","ta","ep","st");
       foreach my $role (@template_roles) {
           $head_script .= &make_script_template($role);
           $button_code .= &make_button_code($role);
       }
       $head_script .= "\n".$jsback."\n".'</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<br />');
       $r->print('<form action="">');
       $r->print($button_code);
       $r->print('</form>');
       $r->print(<<ENDCCF);
   <form name="form1" 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="hidden" name="startrolename" value="'.$env{'form.rolename'}.
      '" />'."\n".'<input type="hidden" name="state" value="" />'."\n".   
      '<input type="reset" value="'.&mt("Reset").'" />'."\n".
      '<input type="submit" value="'.&mt('Define Role').'" /></form>'.
         &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 = '<input type="button" onClick="set_'.$role.'()" value="'.$label.'" />';    
       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 = '<script type="text/javascript">'.$jsback."\n".'</script>';
   
       $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('<h2>');
       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);
           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('<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><form name="customresult" method="post">');
       $r->print(&Apache::lonhtmlcommon::echo_form_input([]).'</form>');
       $r->print(&Apache::loncommon::end_page());
 }  }
   
 # ================================================================ Main Handler  # ================================================================ Main Handler
Line 410  sub handler { Line 2118  sub handler {
     my $r = shift;      my $r = shift;
   
     if ($r->header_only) {      if ($r->header_only) {
        $r->content_type('text/html');         &Apache::loncommon::content_type($r,'text/html');
        $r->send_http_header;         $r->send_http_header;
        return OK;         return OK;
     }      }
   
     if ((&Apache::lonnet::allowed('cta',$ENV{'request.course.id'})) ||      if ((&Apache::lonnet::allowed('cta',$env{'request.course.id'})) ||
         (&Apache::lonnet::allowed('cin',$ENV{'request.course.id'})) ||           (&Apache::lonnet::allowed('cin',$env{'request.course.id'})) || 
         (&Apache::lonnet::allowed('ccr',$ENV{'request.course.id'})) ||           (&Apache::lonnet::allowed('ccr',$env{'request.course.id'})) || 
         (&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) ||          (&Apache::lonnet::allowed('cep',$env{'request.course.id'})) ||
         (&Apache::lonnet::allowed('mau',$ENV{'user.domain'}))) {   (&authorpriv($env{'user.name'},$env{'request.role.domain'})) ||
        $r->content_type('text/html');          (&Apache::lonnet::allowed('mau',$env{'request.role.domain'}))) {
          &Apache::loncommon::content_type($r,'text/html');
        $r->send_http_header;         $r->send_http_header;
        unless ($ENV{'form.phase'}) {         &Apache::lonhtmlcommon::clear_breadcrumbs();
    &phase_one($r);        
        }         my $phase = $env{'form.phase'};
        if ($ENV{'form.phase'} eq 'two') {         my @search = ('srchterm','srchby','srchin','srchtype','srchdomain');
            &phase_two($r);  
        } elsif ($ENV{'form.phase'} eq 'three') {         if (($phase eq 'get_user_info') || ($phase eq 'userpicked')) {
            &phase_three($r);             my $srch;
              foreach my $item (@search) {
                  $srch->{$item} = $env{'form.'.$item};
              }
              if ($env{'form.phase'} eq 'get_user_info') {
                  my ($state,$response,$forcenewuser,$results) = 
                      &user_search_result($srch);
                  if ($state eq 'select') {
                      &print_user_selection_page($r,$response,$srch,$results);
                  } elsif ($state eq 'modify') {
                      my ($ccuname,$ccdomain);
                      if (($srch->{'srchby'} eq 'uname') && 
                          ($srch->{'srchtype'} eq 'exact')) {
                          $ccuname = $srch->{'srchterm'};
                          $ccdomain= $srch->{'srchdomain'};
                      } else {
                          my @matchedunames = keys(%{$results});
                          ($ccuname,$ccdomain) = split(/:/,$matchedunames[0]);
                      }
                      $ccuname =&LONCAPA::clean_username($ccuname);
                      $ccdomain=&LONCAPA::clean_domain($ccdomain);
                      &print_user_modification_page($r,$ccuname,$ccdomain,$srch,
                                                    $response);
                  } elsif ($state eq 'query') {
                      &print_user_query_page($r);
                  } else {
                      &print_username_entry_form($r,$response,$srch,$forcenewuser);
                  }
              } elsif ($env{'form.phase'} eq 'userpicked') {
                  my $ccuname = &LONCAPA::clean_username($env{'form.seluname'});
                  my $ccdomain = &LONCAPA::clean_domain($env{'form.seludom'});
                  &print_user_modification_page($r,$ccuname,$ccdomain,$srch);
              }
          } elsif ($env{'form.phase'} eq 'update_user_data') {
              &update_user_data($r);
          } elsif ($env{'form.phase'} eq 'selected_custom_edit') {
              &custom_role_editor($r);
          } elsif ($env{'form.phase'} eq 'set_custom_roles') {
      &set_custom_role($r);
          } else {
              &print_username_entry_form($r);
        }         }
    } else {     } else {
       $ENV{'user.error.msg'}=        $env{'user.error.msg'}=
         "/adm/createuser:mau:0:0:Cannot modify user data";          "/adm/createuser:mau:0:0:Cannot modify user data";
       return HTTP_NOT_ACCEPTABLE;         return HTTP_NOT_ACCEPTABLE; 
    }     }
    return OK;     return OK;
 }   }
   
   #-------------------------------------------------- functions for &phase_two
   sub user_search_result {
       my ($srch) = @_;
       my %allhomes;
       my %inst_matches;
       my %srch_results;
       my ($response,$state,$forcenewuser);
   
       if ($srch->{'srchby'} !~ /^(uname|lastname|lastfirst)$/) { 
           $response = &mt('Invalid search.');
       }
       if ($srch->{'srchin'} !~ /^(crs|dom|alc|instd)$/) {
           $response = &mt('Invalid search.');
       }
       if ($srch->{'srchtype'} !~ /^(exact|contains)$/) {
           $response = &mt('Invalid search.');
       }
       if ($srch->{'srchterm'} eq '') {
           $response = &mt('You must enter a search term.');
       }
       if (($srch->{'srchin'} eq 'dom') || ($srch->{'srchin'} eq 'instd')) {
           if (($srch->{'srchdomain'} eq '') || 
       ! (&Apache::lonnet::domain($srch->{'srchdomain'}))) {
               $response = &mt('You must specify a valid domain when searching in a domain or institutional directory.')
           }
       }
       if (($srch->{'srchin'} eq 'dom') || ($srch->{'srchin'} eq 'crs') ||
           ($srch->{'srchin'} eq 'alc')) {
           if ($srch->{'srchterm'} !~ /^$match_username$/) {
               $response = &mt('You must specify a valid username. Only the following are allowed: letters numbers - . @');
           }
       }
       if ($srch->{'srchin'} eq 'instd') {
           my $instd_chk = &directorysrch_check($srch);
           if ($instd_chk ne 'ok') {
               $response = $instd_chk;
           }
       }
       if ($response ne '') {
           return ($state,'<span class="LC_warning">'.$response.'</span>');
       }
       if ($srch->{'srchby'} eq 'uname') {
           if (($srch->{'srchin'} eq 'dom') || ($srch->{'srchin'} eq 'crs')) {
               if ($env{'form.forcenew'}) {
                   if ($srch->{'srchdomain'} ne $env{'request.role.domain'}) {
                       my $uhome=&Apache::lonnet::homeserver($srch->{'srchterm'},$srch->{'srchdomain'});
                       if ($uhome eq 'no_host') {
                           my $domdesc = &Apache::lonnet::domain($env{'request.role.domain'},'description');
                           $response = &mt('New users can only be created in the domain to which you current role belongs - [_1].',$env{'request.role.domain'}.' ('.$domdesc.')');
                       } else {
                           $state = 'modify';
                       }
                   } else {
                       $state = 'modify';
                   }
               } else {
                   if ($srch->{'srchin'} eq 'dom') {
                       if ($srch->{'srchtype'} eq 'exact') {
                           my $uhome=&Apache::lonnet::homeserver($srch->{'srchterm'},$srch->{'srchdomain'});
                           if ($uhome eq 'no_host') {
                               ($state,$response,$forcenewuser) =
                                   &build_search_response($srch,%srch_results);
                           } else {
                               $state = 'modify';
                           }
                       } else {
                           %srch_results = &Apache::lonnet::usersearch($srch);
                           ($state,$response,$forcenewuser) =
                               &build_search_response($srch,%srch_results);
                       }
                   } else {
                       my $courseusers = &get_courseusers();
                       if ($srch->{'srchtype'} eq 'exact') {
                           if (exists($courseusers->{$srch->{'srchterm'}.':'.$srch->{'srchdomain'}})) {
                               $state = 'modify';
                           } else {
                               ($state,$response,$forcenewuser) =
                                   &build_search_response($srch,%srch_results);
                           }
                       } else {
                           foreach my $user (keys(%$courseusers)) {
                               my ($cuname,$cudomain) = split(/:/,$user);
                               if ($cudomain eq $srch->{'srchdomain'}) {
                                   if ($cuname =~ /\Q$srch->{'srchterm'}\E/i) {
                                       $srch_results{$user} = 
    {&Apache::lonnet::get('environment',
        ['firstname',
         'lastname',
         'permanentemail'])};
                                   }
                               }
                           }
                           ($state,$response,$forcenewuser) =
                               &build_search_response($srch,%srch_results);
                       }
                   }
               }
           } elsif ($srch->{'srchin'} eq 'alc') {
               $state = 'query';
           } elsif ($srch->{'srchin'} eq 'instd') {
               %srch_results = &Apache::lonnet::inst_directory_query($srch);
               ($state,$response,$forcenewuser) = 
                   &build_search_response($srch,%srch_results); 
           }
       } else {
           if ($srch->{'srchin'} eq 'dom') {
               %srch_results = &Apache::lonnet::usersearch($srch);
               ($state,$response,$forcenewuser) = 
                   &build_search_response($srch,%srch_results); 
           } elsif ($srch->{'srchin'} eq 'crs') {
               my $courseusers = &get_courseusers(); 
               foreach my $user (keys(%$courseusers)) {
                   my ($uname,$udom) = split(/:/,$user);
                   my %names = &Apache::loncommon::getnames($uname,$udom);
                   my %emails = &Apache::loncommon::getemails($uname,$udom);
                   if ($srch->{'srchby'} eq 'lastname') {
                       if ((($srch->{'srchtype'} eq 'exact') && 
                            ($names{'lastname'} eq $srch->{'srchterm'})) || 
                           (($srch->{'srchtype'} eq 'contains') &&
                            ($names{'lastname'} =~ /\Q$srch->{'srchterm'}\E/i))) {
                           $srch_results{$user} = {firstname => $names{'firstname'},
                                               lastname => $names{'lastname'},
                                               permanentemail => $emails{'permanentemail'},
                                              };
                       }
                   } elsif ($srch->{'srchby'} eq 'lastfirst') {
                       my ($srchlast,$srchfirst) = split(/,/,$srch->{'srchterm'});
                       if ($srch->{'srchtype'} eq 'exact') {
                           if (($names{'lastname'} eq $srchlast) &&
                               ($names{'firstname'} eq $srchfirst)) {
                               $srch_results{$user} = {firstname => $names{'firstname'},
                                                   lastname => $names{'lastname'},
                                                   permanentemail => $emails{'permanentemail'},
   
                                              };
                           }
                       } elsif ($srch->{'srchtype'} eq 'contains') {
                           if (($names{'lastname'} =~ /\Q$srchlast\E/i) && 
                               ($names{'firstname'} =~ /\Q$srchfirst\E/i)) {
                               $srch_results{$user} = {firstname => $names{'firstname'},
                                                   lastname => $names{'lastname'},
                                                   permanentemail => $emails{'permanentemail'},
                                                  };
                           }
                       }
                   }
               }
               ($state,$response,$forcenewuser) = 
                   &build_search_response($srch,%srch_results); 
           } elsif ($srch->{'srchin'} eq 'alc') {
               $state = 'query';
           } elsif ($srch->{'srchin'} eq 'instd') {
               %srch_results = &Apache::lonnet::inst_directory_query($srch); 
               ($state,$response,$forcenewuser) = 
                   &build_search_response($srch,%srch_results);
           }
       }
       return ($state,$response,$forcenewuser,\%srch_results);
   }
   
   sub directorysrch_check {
       my ($srch) = @_;
       my $can_search = 0;
       my $response;
       my %dom_inst_srch = &Apache::lonnet::get_dom('configuration',
                                                ['directorysrch'],$srch->{'srchdomain'});
       if (ref($dom_inst_srch{'directorysrch'}) eq 'HASH') {
           if (!$dom_inst_srch{'directorysrch'}{'available'}) {
               return &mt('Institutional directory search unavailable in domain: [_1]',$srch->{'srchdomain'}); 
           }
           if ($dom_inst_srch{'directorysrch'}{'localonly'}) {
               if ($env{'request.role.domain'} ne $srch->{'srchdomain'}) {
                   return &mt('Insitutional directory search in domain: [_1] is only allowed for users with a current role in the domain.',$srch->{'srchdomain'}); 
               }
               my @usertypes = split(/:/,$env{'environment.inststatus'});
               if (!@usertypes) {
                   push(@usertypes,'default');
               }
               if (ref($dom_inst_srch{'directorysrch'}{'cansearch'}) eq 'ARRAY') {
                   foreach my $type (@usertypes) {
                       if (grep(/^\Q$type\E$/,@{$dom_inst_srch{'directorysrch'}{'cansearch'}})) {
                           $can_search = 1;
                           last;
                       }
                   }
               }
               if (!$can_search) {
                   my ($insttypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($srch->{'srchdomain'});
                   my @longtypes; 
                   foreach my $item (@usertypes) {
                       push (@longtypes,$insttypes->{$item});
                   }
                   my $insttype_str = join(', ',@longtypes); 
                   return &mt('Directory search in domain: [_1] is unavailable to your user type: ',$srch->{'srchdomain'}).$insttype_str;
               } 
           } else {
               $can_search = 1;
           }
       } else {
           return &mt('Directory search has not been configured for domain: [_1]',$srch->{'srchdomain'});
       }
       my %longtext = &Apache::lonlocal::texthash (
                          uname     => 'username',
                          lastfirst => 'last name, first name',
                          lastname  => 'last name',
                          contains  => 'contains',
                          exact     => 'as exact match to'
                      );
       if ($can_search) {
           if (ref($dom_inst_srch{'directorysrch'}{'searchby'}) eq 'ARRAY') {
               if (!grep(/^\Q$srch->{'srchby'}\E$/,@{$dom_inst_srch{'directorysrch'}{'searchby'}})) {
                   return &mt('Directory search in domain: [_1] is not available for searching by "[_2]"',$srch->{'srchdomain'},$longtext{$srch->{'srchby'}});
               }
           } else {
               return &mt('Directory search in domain: [_1] is not available.', $srch->{'srchdomain'});
           }
       }
       if ($can_search) {
           if (($dom_inst_srch{'directorysrch'}{'searchtypes'} eq 'specify') ||
               ($dom_inst_srch{'directorysrch'}{'searchtypes'} eq $srch->{'srchtype'})) {
               return 'ok';
           } else {    
               return &mt('Directory search in domain [_1] is not available for the requested search type: "[_2]"',$srch->{'srchdomain'},$longtext{$srch->{'srchtype'}});
           }
       }
   }
   
   
   sub get_courseusers {
       my %advhash;
       my $classlist = &Apache::loncoursedata::get_classlist();
       my %coursepersonnel=&Apache::lonnet::get_course_adv_roles();
       foreach my $role (sort(keys(%coursepersonnel))) {
           foreach my $user (split(/\,/,$coursepersonnel{$role})) {
       if (!exists($classlist->{$user})) {
    $classlist->{$user} = [];
       }
           }
       }
       return $classlist;
   }
   
   sub build_search_response {
       my ($srch,%srch_results) = @_;
       my ($state,$response,$forcenewuser);
       my %names = (
             'uname' => 'username',
             'lastname' => 'last name',
             'lastfirst' => 'last name, first name',
             'crs' => 'this course',
             'dom' => 'this domain',
             'instd' => "your institution's directory",
       );
   
       my %single = (
                      contains => 'A match',
                      exact => 'An exact match',
                    );
       my %nomatch = (
                      contains => 'No match',
                      exact => 'No exact match',
                     );
       if (keys(%srch_results) > 1) {
           $state = 'select';
       } else {
           if (keys(%srch_results) == 1) {
               $state = 'modify';
               $response = &mt("$single{$srch->{'srchtype'}} was found for this $names{$srch->{'srchby'}} ([_1]) in $names{$srch->{'srchin'}}.",$srch->{'srchterm'});
           } else {
               $response = '<span class="LC_warning">'.&mt("$nomatch{$srch->{'srchtype'}} found for this $names{$srch->{'srchby'}} ([_1]) in $names{$srch->{'srchin'}}.",$srch->{'srchterm'}).'</span>';
               if ($srch->{'srchin'} ne 'alc') {
                   $forcenewuser = 1;
                   my $cansrchinst = 0; 
                   if ($srch->{'srchdomain'}) {
                       my %domconfig = &Apache::lonnet::get_dom('configuration',['directorysrch'],$srch->{'srchdomain'});
                       if (ref($domconfig{'directorysrch'}) eq 'HASH') {
                           if ($domconfig{'directorysrch'}{'available'}) {
                               $cansrchinst = 1;
                           } 
                       }
                   }
                   if (($srch->{'srchby'} eq 'lastfirst') || 
                       ($srch->{'srchby'} eq 'lastname')) {
                       if ($srch->{'srchin'} eq 'crs') {
                           $response .= '<br />'.&mt('You may want to broaden your search to the whole domain.'); 
                       } elsif ($srch->{'srchin'} eq 'dom') {
                           if ($cansrchinst) {
                               $response .= '<br />'.&mt('You may want to broaden your search to a search of the institutional directory for this domain.');
                           }
                       }
                   }
               }
           }
       }
       return ($state,$response,$forcenewuser);
   }
   
   sub crumb_utilities {
       my %elements = (
          crtuser => {
              srchterm => 'text',
              srchin => 'selectbox',
              srchby => 'selectbox',
              srchtype => 'selectbox',
              srchdomain => 'selectbox',
          },
          docustom => {
              rolename => 'selectbox',
              newrolename => 'textbox',
          },
       );
   
       my $jsback .= qq|
   function backPage(formname,prevphase,prevstate) {
       formname.phase.value = prevphase;
       formname.state.value = prevstate;
       formname.submit();
   }
   |;
       return ($jsback,\%elements);
   }
   
   sub course_level_table {
       my (%inccourses) = @_;
       my $table = '';
   # Custom Roles?
   
       my %customroles=&my_custom_roles();
       my %lt=&Apache::lonlocal::texthash(
               'exs'  => "Existing sections",
               'new'  => "Define new section",
               'ssd'  => "Set Start Date",
               'sed'  => "Set End Date",
               'crl'  => "Course Level",
               'act'  => "Activate",
               'rol'  => "Role",
               'ext'  => "Extent",
               'grs'  => "Section",
               'sta'  => "Start",
               'end'  => "End"
       );
   
       foreach my $protectedcourse (sort( keys(%inccourses))) {
    my $thiscourse=$protectedcourse;
    $thiscourse=~s:_:/:g;
    my %coursedata=&Apache::lonnet::coursedescription($thiscourse);
    my $area=$coursedata{'description'};
           my $type=$coursedata{'type'};
    if (!defined($area)) { $area=&mt('Unavailable course').': '.$protectedcourse; }
    my ($domain,$cnum)=split(/\//,$thiscourse);
           my %sections_count;
           if (defined($env{'request.course.id'})) {
               if ($env{'request.course.id'} eq $domain.'_'.$cnum) {
                   %sections_count = 
       &Apache::loncommon::get_sections($domain,$cnum);
               }
           }
    foreach my $role ('st','ta','ep','in','cc') {
       if (&Apache::lonnet::allowed('c'.$role,$thiscourse)) {
    my $plrole=&Apache::lonnet::plaintext($role);
    $table .= &Apache::loncommon::start_data_table_row().
   '<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="" />'.
                        '<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().
   $table.
   &Apache::loncommon::end_data_table();
       return $result;
   }
   
   sub course_sections {
       my ($sections_count,$role) = @_;
       my $output = '';
       my @sections = (sort {$a <=> $b} keys %{$sections_count});
       if (scalar(@sections) == 1) {
           $output = '<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;  1;
 __END__  __END__

Removed from v.1.11  
changed lines
  Added in v.1.174


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>