loncom/interface/loncreateuser.pm - diff

Return to loncreateuser.pm CVS log

Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncreateuser.pm between versions 1.12 and 1.106

-version 1.12, 2001/04/12 19:43:49
+version 1.106, 2005/06/23 21:56:12
  Line 1
- # The LearningOnline Network
+ # The LearningOnline Network with CAPA
  # 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,04/12 Gerd Kortemeyer
+ # /home/httpd/html/adm/gpl.txt
  #
+ # http://www.lon-capa.org/
+ #
+ ###
  package Apache::loncreateuser;
+ =pod
+ =head1 NAME
+ Apache::loncreateuser - handler to create users and custom roles
+ =head1 SYNOPSIS
+ Apache::loncreateuser provides an Apache handler for creating users,
+     editing their login parameters, roles, and removing roles, and
+     also creating and assigning custom roles.
+ =head1 OVERVIEW
+ =head2 Custom Roles
+ In LON-CAPA, roles are actually collections of privileges. "Teaching
+ Assistant", "Course Coordinator", and other such roles are really just
+ collection of privileges that are useful in many circumstances.
+ Creating custom roles can be done by the Domain Coordinator through
+ the Create User functionality. That screen will show all privileges
+ that can be assigned to users. For a complete list of privileges,
+ please see C</home/httpd/lonTabs/rolesplain.tab>.
+ Custom role definitions are stored in the C<roles.db> file of the role
+ author.
+ =cut
  use strict;
  use Apache::Constants qw(:common :http);
  use Apache::lonnet;
+ use Apache::loncommon;
+ use Apache::lonlocal;
+ 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 (keys %rolehash) {
+ 	if ($_=~/^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;
+ }
  # =================================================================== Phase one
- sub phase_one {
+ sub print_username_entry_form {
      my $r=shift;
-     my $defdom=$ENV{'user.domain'};
+     my $defdom=$env{'request.role.domain'};
-     $r->print(<<ENDDOCUMENT);
+     my @domains = &Apache::loncommon::get_domains();
- <html>
+     my $domform = &Apache::loncommon::select_dom_form($defdom,'ccdomain');
+     my $html=&Apache::lonxml::xmlbegin();
+     my $bodytag =&Apache::loncommon::bodytag('Create Users, Change User Privileges').&Apache::loncommon::help_open_menu('',undef,undef,'',282,'Instructor Interface');
+     my $selscript=&Apache::loncommon::studentbrowser_javascript();
+     my $sellink=&Apache::loncommon::selectstudent_link
+                                         ('crtuser','ccuname','ccdomain');
+     my %existingroles=&my_custom_roles();
+     my $choice=&Apache::loncommon::select_form('make new role','rolename',
+ 		('make new role' => 'Generate new role ...',%existingroles));
+     my %lt=&Apache::lonlocal::texthash(
+ 		    'siur'   => "Set Individual User Roles",
+ 		    'usr'  => "Username",
+                     'dom'  => "Domain",
+                     'usrr' => "User Roles",
+                     'ecrp' => "Edit Custom Role Privileges",
+                     'nr'   => "Name of Role",
+                     'cre'  => "Custom Role Editor"
+ 				       );
+     my $helpsiur=&Apache::loncommon::help_open_topic('Course_Change_Privileges');
+     my $helpecpr=&Apache::loncommon::help_open_topic('Course_Editing_Custom_Roles');
+     $r->print(<<"ENDDOCUMENT");
+ $html
  <head>
  <title>The LearningOnline Network with CAPA</title>
+ $selscript
  </head>
- <body bgcolor="#FFFFFF">
+ $bodytag
- <h1>Create User, Change User Privileges</h1>
+ <form action="/adm/createuser" method="post" name="crtuser">
- <form action=/adm/createuser method=post>
+ <input type="hidden" name="phase" value="get_user_info">
- <input type=hidden name=phase value=two>
+ <h2>$lt{siur}$helpsiur</h2>
- Username: <input type=text size=15 name=ccuname><br>
+ <table>
- Domain: <input type=text size=15 name=ccdomain value=$defdom><p>
+ <tr><td>$lt{usr}:</td><td><input type="text" size="15" name="ccuname">
- <input type=submit value="Continue">
+ </td><td rowspan="2">$sellink</td></tr><tr><td>
+ $lt{'dom'}:</td><td>$domform</td></tr>
+ </table>
+ <input name="userrole" type="submit" value="$lt{usrr}" />
  </form>
+ ENDDOCUMENT
+    if (&Apache::lonnet::allowed('mcr','/')) {
+        $r->print(<<ENDCUSTOM);
+ <form action="/adm/createuser" method="post" name="docustom">
+ <input type="hidden" name="phase" value="selected_custom_edit">
+ <h2>$lt{'ecrp'}$helpecpr</h2>
+ $lt{'nr'}: $choice <input type="text" size="15" name="newrolename" /><br />
+ <input name="customeditor" type="submit" value="$lt{'cre'}" />
  </body>
  </html>
- ENDDOCUMENT
+ ENDCUSTOM
+    }
  }
  # =================================================================== Phase two
+ sub print_user_modification_page {
- sub phase_two {
      my $r=shift;
-     my $ccuname=$ENV{'form.ccuname'};
+     my $ccuname=$env{'form.ccuname'};
-     my $ccdomain=$ENV{'form.ccdomain'};
+     my $ccdomain=$env{'form.ccdomain'};
-     $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
+     $ccuname=~s/\W//g;
-     my $krbdefdom=$1;
+     $ccdomain=~s/\W//g;
-     $krbdefdom=~tr/a-z/A-Z/;
+     unless (($ccuname) && ($ccdomain)) {
+ 	&print_username_entry_form($r);
+         return;
+     }
+     my $defdom=$env{'request.role.domain'};
-     my $defdom=$ENV{'user.domain'};
+     my ($krbdef,$krbdefdom) =
+        &Apache::loncommon::get_kerberos_defaults($defdom);
+     my %param = ( formname => 'document.cu',
+                   kerb_def_dom => $krbdefdom,
+                   kerb_def_auth => $krbdef
+                   );
+     $loginscript  = &Apache::loncommon::authform_header(%param);
+     $authformkrb  = &Apache::loncommon::authform_kerberos(%param);
      $ccuname=~s/\W//g;
      $ccdomain=~s/\W//g;
-     $r->print(<<ENDENHEAD);
+     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
- <html>
+     my $dc_setcourse_code = '';
+     my $loaditem;
+     if ($env{'request.role'} =~ m-^dc\./(\w+)/$-) {
+         my $dcdom = $1;
+         $loaditem = qq|OnLoad="document.cu.coursedesc.value=''"|;
+         $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;
+             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
+                 }
+                 var numsplit = document.cu.newsec.value.split(/,/g);
+                 numsections = numsections + numsplit.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;
+             }
+             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 numcourse = getIndex(document.cu.dccourse);
+             if (numcourse == "-1") {
+                 alert("There was a problem with your course selection");
+                 return
+             }
+             else {
+                 var coursename = "_$dcdom"+"_"+course+"_"+userrole
+                 document.cu.elements[numcourse].name = "act"+coursename
+                 document.cu.elements[numcourse+4].name = "sec"+coursename
+                 document.cu.elements[numcourse+4].value = section
+                 document.cu.elements[numcourse+5].name = "start"+coursename
+                 document.cu.elements[numcourse+6].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
+     }
+     my $html=&Apache::lonxml::xmlbegin();
+     my $dochead =<<"ENDDOCHEAD";
+ $html
  <head>
  <title>The LearningOnline Network with CAPA</title>
- <script>
+ <script type="text/javascript" language="Javascript">
      function pclose() {
          parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
- Line 74  sub phase_two {
+ Line 287  sub phase_two {
          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() {
          eval("document.cu."+document.cu.pres_marker.value+
- Line 89  sub phase_two {
+ Line 296  sub phase_two {
          pclose();
      }
+     function setSections() {
+         var re1 = /^currsec_/;
+         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) {
+                 var re2 = /^currsec_[a-zA-Z0-9]+_[a-zA-Z0-9]+_(\\w+)\$/;
+                 if (document.cu.elements[i-1].checked == true) {
+                     var re2 = /^currsec_[a-zA-Z0-9]+_[a-zA-Z0-9]+_(\\w+)\$/;
+                     match = re2.exec(str);
+                     var role = match[1];
+                     if (role == 'cc') {
+                         alert("Section designations do not apply to Course Coordinator roles.\\nA course coordinator role will be added with access to all sections.");
+                     }
+                     else {
+                         var sections = '';
+                         var numsec = 0;
+                         var sections;
+                         for (var j=0; j<document.cu.elements[i].length; j++) {
+                             if (document.cu.elements[i].options[j].selected == true ) {
+                                 if (document.cu.elements[i].options[j].value != "") {
+                                     if (numsec == 0) {
+                                         if (document.cu.elements[i].options[j].value != "") {
+                                             sections = document.cu.elements[i].options[j].value;
+                                             numsec ++;
+                                         }
+                                     }
+                                     else {
+                                         sections = sections + "," +  document.cu.elements[i].options[j].value
+                                         numsec ++;
+                                     }
+                                 }
+                             }
+                         }
+                         if (numsec > 0) {
+                             if (document.cu.elements[i+1].value != "" && document.cu.elements[i+1].value != null) {
+                                 sections = sections + "," +  document.cu.elements[i+1].value;
+                             }
+                         }
+                         else {
+                             sections = document.cu.elements[i+1].value;
+                         }
+                         var newsecs = document.cu.elements[i+1].value;
+                         if (newsecs != null && newsecs != "") {
+                             var 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 {
+                             document.cu.elements[i+2].value = sections;
+                         }
+                     }
+                 }
+             }
+         }
+         document.cu.submit();
+     }
  </script>
  </head>
- <body bgcolor="#FFFFFF">
+ ENDDOCHEAD
- <img align=right src=/adm/lonIcons/lonlogos.gif>
+     $r->print(&Apache::loncommon::bodytag(
- <h1>Create User, Change User Privileges</h1>
+                                      'Create Users, Change User Privileges',undef,$loaditem));
- <form action=/adm/createuser method=post name=cu>
+     my $forminfo =<<"ENDFORMINFO";
- <input type=hidden name=phase value=three>
+ <form action="/adm/createuser" method="post" name="cu">
- <input type=hidden name=ccuname value=$ccuname>
+ <input type="hidden" name="phase"       value="update_user_data">
- <input type=hidden name=ccdomain value=$ccdomain>
+ <input type="hidden" name="ccuname"     value="$ccuname">
- <input type="hidden" value='' name="pres_value">
+ <input type="hidden" name="ccdomain"    value="$ccdomain">
- <input type="hidden" value='' name="pres_type">
+ <input type="hidden" name="pres_value"  value="" >
- <input type="hidden" value='' name="pres_marker">
+ <input type="hidden" name="pres_type"   value="" >
- <input type=hidden name=cuname value="$ccuname">
+ <input type="hidden" name="pres_marker" value="" >
- <input type=hidden name=cdomain value="$ccdomain">
+ ENDFORMINFO
- ENDENHEAD
      my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
      my %incdomains;
      my %inccourses;
-     $incdomains{$ENV{'user.domain'}}=1;
+     foreach (values(%Apache::lonnet::hostdom)) {
-     map {
+        $incdomains{$_}=1;
+     }
+     foreach (keys(%env)) {
  	if ($_=~/^user\.priv\.cm\.\/(\w+)\/(\w+)/) {
  	    $inccourses{$1.'_'.$2}=1;
          }
-     } %ENV;
+     }
      if ($uhome eq 'no_host') {
- 	$r->print(<<ENDNUSER);
+         my $home_server_list=
- <h2>New user $ccuname at $ccdomain</h2>
+             '<option value="default" selected>default</option>'."\n".
- <script>
+                 &Apache::loncommon::home_server_option_list($ccdomain);
- function setkrb(vf) {
-     if (vf.krbdom.value!='') {
+ 	my %lt=&Apache::lonlocal::texthash(
-        vf.login[0].checked=true;
+                     'cnu'  => "Create New User",
-        vf.krbdom.value=vf.krbdom.value.toUpperCase();
+                     'nu'   => "New User",
-        vf.intpwd.value='';
+                     'id'   => "in domain",
-    }
+                     'pd'   => "Personal Data",
- }
+                     'fn'   => "First Name",
+                     'mn'   => "Middle Name",
- function setint(vf) {
+                     'ln'   => "Last Name",
-     if (vf.intpwd.value!='') {
+                     'gen'  => "Generation",
-        vf.login[1].checked=true;
+                     'idsn' => "ID/Student Number",
-        vf.krbdom.value='';
+                     'hs'   => "Home Server",
-    }
+                     'lg'   => "Login Data"
- }
+ 				       );
+ 	my $genhelp=&Apache::loncommon::help_open_topic('Generation');
- function clickkrb(vf) {
+         &initialize_authen_forms();
-     vf.krbdom.value='$krbdefdom';
+ 	$r->print(<<ENDNEWUSER);
-     vf.intpwd.value='';
+ $dochead
- }
+ <h1>$lt{'cnu'}</h1>
+ $forminfo
- function clickint(vf) {
+ <h2>$lt{'nu'} "$ccuname" $lt{'id'} $ccdomain</h2>
-     vf.krbdom.value='';
+ <script type="text/javascript" language="Javascript">
- }
+ $loginscript
  </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' /></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' /></td></tr>
+ <tr><td>$lt{'ln'}   </td>
- <h3>Login Data</h3>
+     <td><input type='text' name='clast'   size='15' /></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'  /></td></tr>
- <input type=text size=10 name=krbdom onChange="setkrb(this.form);"><p>
+ </table>
- <input type=radio name=login value=int onClick="clickint(this.form);">
+ $lt{'idsn'} <input type='text' name='cstid'   size='15' /></p>
- Internally authenticated (with initial password
+ $lt{'hs'}: <select name="hserver" size="1"> $home_server_list </select>
- <input type=text size=10 name=intpwd onChange="setint(this.form);">)
+ <hr />
- ENDNUSER
+ <h3>$lt{'lg'}</h3>
-     } else {
+ <p>$generalrule </p>
- 	$r->print('<h2>Existing user '.$ccuname.' at '.$ccdomain.'</h2>');
+ <p>$authformkrb </p>
+ <p>$authformint </p>
-         my $rolesdump=&Apache::lonnet::reply(
+ <p>$authformfsys</p>
-                                   "dump:$ccdomain:$ccuname:roles",$uhome);
+ <p>$authformloc </p>
-         unless ($rolesdump eq 'con_lost') {
+ ENDNEWUSER
+     } else { # user already exists
+ 	my %lt=&Apache::lonlocal::texthash(
+                     'cup'  => "Change User Privileges",
+                     'usr'  => "User",
+                     'id'   => "in domain",
+                     'fn'   => "first name",
+                     'mn'   => "middle name",
+                     'ln'   => "last name",
+                     'gen'  => "generation"
+ 				       );
+ 	$r->print(<<ENDCHANGEUSER);
+ $dochead
+ <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'],
+                           $ccdomain,$ccuname);
+         my %rolesdump=&Apache::lonnet::dump('roles',$ccdomain,$ccuname);
+         $r->print(<<END);
+ <hr />
+ <table border="2">
+ <tr>
+ <th>$lt{'fn'}</th><th>$lt{'mn'}</th><th>$lt{'ln'}</th><th>$lt{'gen'}</th>
+ </tr>
+ <tr>
+ END
+         foreach ('firstname','middlename','lastname','generation') {
+            if (&Apache::lonnet::allowed('mau',$ccdomain)) {
+               $r->print(<<"END");
+ <td><input type="text" name="c$_" value="$userenv{$_}" size="15" /></td>
+ END
+            } else {
+                $r->print('<td>'.$userenv{$_}.'</td>');
+            }
+         }
+       $r->print(<<END);
+ </tr>
+ </table>
+ END
+         # 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;
-            $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=~/^cr\/(\w+)\/(\w+)\/(\w+)$/);
-                  $area=$carea;
+                my $bgcol='ffffff';
- 	      } else {
+                my $allowed=0;
-                  if ($area=~/^\/(\w+)\//) {
+                my $delallowed=0;
- 		     $incdomains{$1}=1;
+ 	       my $sortkey=$role_code;
-                      if (&Apache::lonnet::allowed('c'.$trole,$1)) {
+ 	       my $class='Unknown';
- 			 $allows=1;
+                if ($area =~ /^\/(\w+)\/(\d\w+)/ ) {
-                      }
+ 		   $class='Course';
-                  } else {
+                    my ($coursedom,$coursedir) = ($1,$2);
-                      if (&Apache::lonnet::allowed('c'.$trole,'/')) {
+ 		   $sortkey.="\0$1";
- 			 $allows=1;
+                    # $1.'_'.$2 is the course id (eg. 103_12345abcef103l3).
-                      }
+                    my %coursedata=
-                  }
+                        &Apache::lonnet::coursedescription($1.'_'.$2);
- 	      }
+ 		   my $carea;
+ 		   if (defined($coursedata{'description'})) {
-               my $active=1;
+ 		       $carea=$coursedata{'description'}.
-               if (($tend) && ($now>$tend)) { $active=0; }
+                            '<br />'.&mt('Domain').': '.$coursedom.('&nbsp;'x8).
+      &Apache::loncommon::syllabuswrapper('Syllabus',$coursedir,$coursedom);
-               $r->print('<tr bgcolor=#'.$bgcol.'><td>');
+ 		       $sortkey.="\0".$coursedata{'description'};
-               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 {
+                    $inccourses{$1.'_'.$2}=1;
-                      $r->print('&nbsp;');
+                    if ((&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) ||
-                  }
+                        (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
-               } else {
+                        $allowed=1;
-                   $r->print('&nbsp;');
+                    }
-               }
+                    if ((&Apache::lonnet::allowed('dro',$1)) ||
-               $r->print('</td><td>'.&Apache::lonnet::plaintext($trole).
+                        (&Apache::lonnet::allowed('dro',$ccdomain))) {
-                         '</td><td>'.$area.'</td><td>'.
+                        $delallowed=1;
-                         ($tstart?localtime($tstart):'&nbsp;').'</td><td>'.
+                    }
-                         ($tend?localtime($tend):'&nbsp;')."</td></tr>\n");
+ # - custom role. Needs more info, too
- 	     }
+ 		   if ($croletitle) {
- 	   } split(/&/,$rolesdump);
+ 		       if (&Apache::lonnet::allowed('ccr',$1.'/'.$2)) {
- 	   $r->print('</table>');
+ 			   $allowed=1;
-          }
+ 			   $thisrole.='.'.$role_code;
+ 		       }
+ 		   }
+                    # Compute the background color based on $area
+                    $bgcol=$1.'_'.$2;
+                    $bgcol=~s/[^7-9a-e]//g;
+                    $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',2,6);
+                    if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {
+                        $carea.='<br />Section/Group: '.$3;
+ 		       $sortkey.="\0$3";
+                    }
+                    $area=$carea;
+                } else {
+ 		   $sortkey.="\0".$area;
+                    # Determine if current user is able to revoke privileges
+                    if ($area=~ /^\/(\w+)\//) {
+                        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=~/\/(\w+)\/(\w+)/;
+ 		   if (&authorpriv($2,$1)) {
+ 		       $allowed=1;
+                    } else {
+                        $allowed=0;
+                    }
+                }
+ 	       $bgcol='77FF77';
+                my $row = '';
+                $row.='<tr bgcolor="#'.$bgcol.'"><td>';
+                my $active=1;
+                $active=0 if (($role_end_time) && ($now>$role_end_time));
+                if (($active) && ($allowed)) {
+                    $row.= '<input type="checkbox" name="rev:'.$thisrole.'">';
+                } else {
+                    if ($active) {
+                       $row.='&nbsp;';
+ 		   } else {
+                       $row.=&mt('expired or revoked');
+ 		   }
+                }
+ 	       $row.='</td><td>';
+                if ($allowed && !$active) {
+                    $row.= '<input type="checkbox" name="ren:'.$thisrole.'">';
+                } else {
+                    $row.='&nbsp;';
+                }
+ 	       $row.='</td><td>';
+                if ($delallowed) {
+                    $row.= '<input type="checkbox" name="del:'.$thisrole.'">';
+                } else {
+                    $row.='&nbsp;';
+                }
+ 	       my $plaintext='';
+ 	       unless ($croletitle) {
+ 		   $plaintext=&Apache::lonnet::plaintext($role_code);
+ 	       } 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></tr>\n";
+ 	       $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','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}.=$roletext{$sortrole{$which}};
+ 		   }
+ 	       }
+ 	       unless($output{$type} eq '') {
+ 		   $output{$type} = "<tr bgcolor='#BBffBB'>".
+ 			     "<td align='center' colspan='7'>".&mt($type)."</td>".
+                               $output{$type};
+                    $rolesdisplay = 1;
+ 	       }
+ 	   }
+            if ($rolesdisplay == 1) {
+                $r->print(<<END);
+ <hr />
+ <h3>$lt{'rer'}</h3>
+ <table>
+ <tr><th>$lt{'rev'}</th><th>$lt{'ren'}</th><th>$lt{'del'}</th><th>$lt{'rol'}</th><th>$lt{'e
+ xt'}</th><th>$lt{'sta'}</th><th>$lt{'end'}</th>
+ END
+                foreach my $type ('Construction Space','Course','Domain','System','Unknown') {
+                    if ($output{$type}) {
+                        $r->print($output{$type}."\n");
+                    }
+                }
+ 	       $r->print('</table>');
+            }
+         }  # End of unless
+ 	my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);
+ 	if ($currentauth=~/^krb(4|5):/) {
+ 	    $currentauth=~/^krb(4|5):(.*)/;
+ 	    my $krbdefdom=$1;
+             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',$env{'request.role.domain'})) {
+                 &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 users
+                 # 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 />
+ <script type="text/javascript" language="Javascript">
+ $loginscript
+ </script>
+ <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',$env{'request.role.domain'})) {
+ 		# 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
+             }
+         }  ## 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(<<ENDCOAUTH);
+ <h4>$lt{'cs'}</h4>
+ <table border=2><tr><th>$lt{'act'}</th><th>$lt{'rol'}</th><th>$lt{'ext'}</th>
+ <th>$lt{'sta'}</th><th>$lt{'end'}</th></tr>
+ <tr>
+ <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>
+ </tr>
+ <tr>
+ <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>
+ </tr>
+ </table>
+ ENDCOAUTH
      }
-     $r->print('<hr><h3>Add Roles</h3><h4>System Level</h4>');
  #
  # 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 {
+     '<table border=2><tr><th>'.&mt('Activate').'</th><th>'.&mt('Role').'</th><th>'.&mt('Extent').'</th>'.
+     '<th>'.&mt('Start').'</th><th>'.&mt('End').'</th></tr>';
+     foreach ( sort( keys(%incdomains))) {
  	my $thisdomain=$_;
-         map {
+         foreach ('dc','li','dg','au','sc') {
              if (&Apache::lonnet::allowed('c'.$_,$thisdomain)) {
                 my $plrole=&Apache::lonnet::plaintext($_);
-                $r->print(<<ENDDROW);
+ 	       my %lt=&Apache::lonlocal::texthash(
+                     'ssd'  => "Set Start Date",
+                     'sed'  => "Set End Date"
+ 				       );
+                $num_domain_level ++;
+                $domaintext .= <<"ENDDROW";
  <tr>
  <td><input type=checkbox name="act_$thisdomain\_$_"></td>
  <td>$plrole</td>
  <td>$thisdomain</td>
  <td><input type=hidden name="start_$thisdomain\_$_" value=''>
  <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\_$_.value,'start_$thisdomain\_$_','cu.pres','dateset')">$lt{'ssd'}</a></td>
  <td><input type=hidden name="end_$thisdomain\_$_" value=''>
  <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\_$_.value,'end_$thisdomain\_$_','cu.pres','dateset')">$lt{'sed'}</a></td>
  </tr>
  ENDDROW
              }
-         } ('dc','li','dg','au');
+         }
-     } sort keys %incdomains;
+     }
-     $r->print('</table>');
+     $domaintext.='</table>';
+     if ($num_domain_level > 0) {
+         $r->print($domaintext);
+     }
  #
  # Course level
  #
-     $r->print('<h4>Course Level</h4>'.
+     my $num_sections;
-     '<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>'.
-     '<th>Group/Section</th><th>Start</th><th>End</th></tr>');
-     map {
- 	my $thiscourse=$_;
-         $thiscourse=~s/\_/\//g;
-         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\./(\w+)/$-) {
-         } ('st','ta','ep','ad','in','cc');
+         $r->print(&course_level_dc($1));
-     } 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("</form></body></html>");
  }
  # ================================================================= Phase Three
+ sub update_user_data {
- sub phase_three {
      my $r=shift;
+     my $uhome=&Apache::lonnet::homeserver($env{'form.ccuname'},
+                                           $env{'form.ccdomain'});
+     # Error messages
+     my $error     = '<font color="#ff0000">'.&mt('Error').':</font>';
+     my $end       = '</body></html>';
+     # Print header
+     my $html=&Apache::lonxml::xmlbegin();
      $r->print(<<ENDTHREEHEAD);
- <html>
+ $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>');
+     my $title;
-    if ($ENV{'form.makeuser'}) {
+     if (exists($env{'form.makeuser'})) {
-     $r->print('<h3>Creating User</h3>');
+ 	$title='Set Privileges for New User';
-     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'}));
- 	} else {
-            $r->print('Invalid login mode or password');
-         }
      } else {
-         $r->print('Invalid username or domain');
+         $title='Modify User Privileges';
      }
-    }
+     $r->print(&Apache::loncommon::bodytag($title));
-     my $now=time;
+     # Check Inputs
-     $r->print('<h3>Modifying Roles</h3>');
+     if (! $env{'form.ccuname'} ) {
-     map {
+ 	$r->print($error.&mt('No login name specified').'.'.$end);
- 	if (($_=~/^form\.rev\:([^\_]+)\_([^\_]+)$/) && ($ENV{$_})) {
+ 	return;
-            $r->print('Revoking '.$2.' in '.$1.': '.
+     }
-           &Apache::lonnet::assignrole($ENV{'form.cdomain'},$ENV{'form.cuname'},
+     if (  $env{'form.ccuname'}  =~/\W/) {
-                                       $1,$2,$now).'<br>');
+ 	$r->print($error.&mt('Invalid login name').'.  '.
-            if ($2 eq 'st') {
+ 		  &mt('Only letters, numbers, and underscores are valid').'.'.
-                $1=~/^\/(\w+)\/(\w+)/;
+ 		  $end);
-                my $cid=$1.'_'.$2;
+ 	return;
- 	       $r->print('Drop from classlist: '.
+     }
-           &Apache::lonnet::critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
+     if (! $env{'form.ccdomain'}       ) {
- 	              $ENV{'course.'.$cid.'.num'}.':classlist:'.
+ 	$r->print($error.&mt('No domain specified').'.'.$end);
-                       &Apache::lonnet::escape($ENV{'form.cuname'}.':'.
+ 	return;
-                                               $ENV{'form.cdomain'}).'='.
+     }
-                       &Apache::lonnet::escape($now.':'),
+     if (  $env{'form.ccdomain'} =~/\W/) {
- 	              $ENV{'course.'.$cid.'.home'}).'<br>');
+ 	$r->print($error.&mt ('Invalid domain name').'.  '.
-            }
+ 		  &mt('Only letters, numbers, and underscores are valid').'.'.
+ 		  $end);
+ 	return;
+     }
+     if (! exists($env{'form.makeuser'})) {
+         # Modifying an existing user, so check the validity of the name
+         if ($uhome eq 'no_host') {
+             $r->print($error.&mt('Unable to determine home server for ').
+                       $env{'form.ccuname'}.&mt(' in domain ').
+                       $env{'form.ccdomain'}.'.');
+             return;
+         }
+     }
+     # Determine authentication method and password for the user being modified
+     my $amode='';
+     my $genpwd='';
+     if ($env{'form.login'} eq 'krb') {
+ 	$amode='krb';
+ 	$amode.=$env{'form.krbver'};
+ 	$genpwd=$env{'form.krbarg'};
+     } elsif ($env{'form.login'} eq 'int') {
+ 	$amode='internal';
+ 	$genpwd=$env{'form.intarg'};
+     } elsif ($env{'form.login'} eq 'fsys') {
+ 	$amode='unix';
+ 	$genpwd=$env{'form.fsysarg'};
+     } elsif ($env{'form.login'} eq 'loc') {
+ 	$amode='localauth';
+ 	$genpwd=$env{'form.locarg'};
+ 	$genpwd=" " if (!$genpwd);
+     } elsif (($env{'form.login'} eq 'nochange') ||
+              ($env{'form.login'} eq ''        )) {
+         # There is no need to tell the user we did not change what they
+         # did not ask us to change.
+         # If they are creating a new user but have not specified login
+         # information this will be caught below.
+     } else {
+ 	    $r->print($error.&mt('Invalid login mode or password').$end);
+ 	    return;
+     }
+     if ($env{'form.makeuser'}) {
+         # Create a new user
+ 	my %lt=&Apache::lonlocal::texthash(
+                     'cru'  => "Creating user",
+                     'id'   => "in domain"
+ 					   );
+ 	$r->print(<<ENDNEWUSERHEAD);
+ <h3>$lt{'cru'} "$env{'form.ccuname'}" $lt{'id'} "$env{'form.ccdomain'}"</h3>
+ ENDNEWUSERHEAD
+         # Check for the authentication mode and password
+         if (! $amode || ! $genpwd) {
+ 	    $r->print($error.&mt('Invalid login mode or password').$end);
+ 	    return;
+ 	}
+         # Determine desired host
+         my $desiredhost = $env{'form.hserver'};
+         if (lc($desiredhost) eq 'default') {
+             $desiredhost = undef;
+         } else {
+             my %home_servers = &Apache::loncommon::get_library_servers
+                 ($env{'form.ccdomain'});
+             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::libserv{$home});
+     } elsif (($env{'form.login'} ne 'nochange') &&
+              ($env{'form.login'} ne ''        )) {
+ 	# Modify user privileges
+     my %lt=&Apache::lonlocal::texthash(
+                     'usr'  => "User",
+                     'id'   => "in domain"
+ 				       );
+ 	$r->print(<<ENDMODIFYUSERHEAD);
+ <h2>$lt{'usr'} "$env{'form.ccuname'}" $lt{'id'} "$env{'form.ccdomain'}"</h2>
+ ENDMODIFYUSERHEAD
+         if (! $amode || ! $genpwd) {
+ 	    $r->print($error.'Invalid login mode or password'.$end);
+ 	    return;
+ 	}
+ 	# Only allow authentification modification if the person has authority
+ 	if (&Apache::lonnet::allowed('mau',$env{'form.ccdomain'})) {
+ 	    $r->print('Modifying authentication: '.
+                       &Apache::lonnet::modifyuserauth(
+ 		       $env{'form.ccdomain'},$env{'form.ccuname'},
+                        $amode,$genpwd));
+             $r->print('<br />'.&mt('Home server').': '.&Apache::lonnet::homeserver
+ 		  ($env{'form.ccuname'},$env{'form.ccdomain'}));
+ 	} else {
+ 	    # Okay, this is a non-fatal error.
+ 	    $r->print($error.&mt('You do not have the authority to modify this users authentification information').'.');
  	}
-     } keys %ENV;
+     }
-     map {
+     ##
- 	if (($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_([^\_]+)$/) && ($ENV{$_})) {
+     if (! $env{'form.makeuser'} ) {
-             my $url='/'.$1.'/'.$2;
+         # Check for need to change
-             if ($ENV{'form.sec_'.$1.'_'.$2.'_'.$3}) {
+         my %userenv = &Apache::lonnet::get
- 		$url.='/'.$ENV{'form.sec_'.$1.'_'.$2.'_'.$3};
+             ('environment',['firstname','middlename','lastname','generation'],
-             }
+              $env{'form.ccdomain'},$env{'form.ccuname'});
-             my $start=$now;
+         my ($tmp) = keys(%userenv);
-             if ($ENV{'form.start_'.$1.'_'.$2.'_'.$3}) {
+         if ($tmp =~ /^(con_lost|error)/i) {
- 		$start=$ENV{'form.start_'.$1.'_'.$2.'_'.$3};
+             %userenv = ();
-             }
+         }
-             my $end=0;
+         # Check to see if we need to change user information
-             if ($ENV{'form.end_'.$1.'_'.$2.'_'.$3}) {
+         foreach ('firstname','middlename','lastname','generation') {
- 		$end=$ENV{'form.end_'.$1.'_'.$2.'_'.$3};
+             # Strip leading and trailing whitespace
-             }
+             $env{'form.c'.$_} =~ s/(\s+$|^\s+)//g;
-             $r->print('Assigning: '.$3.' in '.$url.': '.
+         }
-           &Apache::lonnet::assignrole($ENV{'form.cdomain'},$ENV{'form.cuname'},
+         if (&Apache::lonnet::allowed('mau',$env{'form.ccdomain'}) &&
-                                       $url,$3,$end,$start).'<br>');
+             ($env{'form.cfirstname'}  ne $userenv{'firstname'}  ||
-             if ($3 eq 'st') {
+              $env{'form.cmiddlename'} ne $userenv{'middlename'} ||
- 		$url=~/^\/(\w+)\/(\w+)/;
+              $env{'form.clastname'}   ne $userenv{'lastname'}   ||
-                 my $cid=$1.'_'.$2;
+              $env{'form.cgeneration'} ne $userenv{'generation'} )) {
-                $r->print('Add to classlist: '.
+             # Make the change
-           &Apache::lonnet::critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
+             my %changeHash;
- 	              $ENV{'course.'.$cid.'.num'}.':classlist:'.
+             $changeHash{'firstname'}  = $env{'form.cfirstname'};
-                       &Apache::lonnet::escape($ENV{'form.cuname'}.':'.
+             $changeHash{'middlename'} = $env{'form.cmiddlename'};
-                                               $ENV{'form.cdomain'}).'='.
+             $changeHash{'lastname'}   = $env{'form.clastname'};
-                       &Apache::lonnet::escape($end.':'.$start),
+             $changeHash{'generation'} = $env{'form.cgeneration'};
- 	              $ENV{'course.'.$cid.'.home'}).'<br>');
+             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",
+                              '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></tr>
+ <tr><td>$lt{'prvs'}</td>
+     <td>$userenv{'firstname'}  </td>
+     <td>$userenv{'middlename'} </td>
+     <td>$userenv{'lastname'}   </td>
+     <td>$userenv{'generation'} </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></tr>
+ </table>
+ END
+             } 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
+             # They did not want to change the users name but we can
+             # still tell them what the name is
+ 	    my %lt=&Apache::lonlocal::texthash(
+                            'usr'  => "User",
+                            'id'   => "in domain",
+                            'gen'  => "Generation"
+ 					       );
+                 $r->print(<<"END");
+ <h2>$lt{'usr'} "$env{'form.ccuname'}" $lt{'id'} "$env{'form.ccdomain'}"</h2>
+ <h4>$userenv{'firstname'} $userenv{'middlename'} $userenv{'lastname'} </h4>
+ <h4>$lt{'gen'}: $userenv{'generation'}</h4>
+ END
+         }
+     }
+     ##
+     my $now=time;
+     $r->print('<h3>'.&mt('Modifying Roles').'</h3>');
+     foreach (keys (%env)) {
+ 	next if (! $env{$_});
+ 	# Revoke roles
+ 	if ($_=~/^form\.rev/) {
+ 	    if ($_=~/^form\.rev\:([^\_]+)\_([^\_\.]+)$/) {
+ # Revoke standard role
+ 	        $r->print(&mt('Revoking').' '.$2.' in '.$1.': <b>'.
+                      &Apache::lonnet::revokerole($env{'form.ccdomain'},
+                      $env{'form.ccuname'},$1,$2).'</b><br />');
+ 		if ($2 eq 'st') {
+ 		    $1=~/^\/(\w+)\/(\w+)/;
+ 		    my $cid=$1.'_'.$2;
+ 		    $r->print(&mt('Drop from classlist').': <b>'.
+ 			 &Apache::lonnet::critical('put:'.
+                              $env{'course.'.$cid.'.domain'}.':'.
+ 	                     $env{'course.'.$cid.'.num'}.':classlist:'.
+                          &Apache::lonnet::escape($env{'form.ccuname'}.':'.
+                              $env{'form.ccdomain'}).'='.
+                          &Apache::lonnet::escape($now.':'),
+ 	                     $env{'course.'.$cid.'.home'}).'</b><br />');
+ 		}
+ 	    }
+ 	    if ($_=~/^form\.rev\:([^\_]+)\_cr\.cr\/(\w+)\/(\w+)\/(\w+)$/) {
+ # Revoke custom role
+ 		$r->print(&mt('Revoking custom role').
+                       ' '.$4.' by '.$3.'@'.$2.' in '.$1.': <b>'.
+                       &Apache::lonnet::revokecustomrole($env{'form.ccdomain'},
+ 				  $env{'form.ccuname'},$1,$2,$3,$4).
+ 		'</b><br />');
  	    }
- 	} elsif (($_=~/^form\.act\_([^\_]+)\_([^\_]+)$/) && ($ENV{$_})) {
+ 	} elsif ($_=~/^form\.del/) {
-             my $url='/'.$1.'/';
+ 	    if ($_=~/^form\.del\:([^\_]+)\_([^\_]+)$/) {
-             my $start=$now;
+ 	        $r->print(&mt('Deleting').' '.$2.' in '.$1.': '.
-             if ($ENV{'form.start_'.$1.'_'.$2}) {
+                      &Apache::lonnet::assignrole($env{'form.ccdomain'},
- 		$start=$ENV{'form.start_'.$1.'_'.$2};
+                      $env{'form.ccuname'},$1,$2,$now,0,1).'<br />');
-             }
+ 		if ($2 eq 'st') {
-             my $end=0;
+ 		    $1=~/^\/(\w+)\/(\w+)/;
-             if ($ENV{'form.end_'.$1.'_'.$2}) {
+ 		    my $cid=$1.'_'.$2;
- 		$end=$ENV{'form.end_'.$1.'_'.$2};
+ 		    $r->print(&mt('Drop from classlist').': <b>'.
-             }
+ 			 &Apache::lonnet::critical('put:'.
-             $r->print('Assigning: '.$2.' in '.$url.': '.
+                              $env{'course.'.$cid.'.domain'}.':'.
-           &Apache::lonnet::assignrole($ENV{'form.cdomain'},$ENV{'form.cuname'},
+ 	                     $env{'course.'.$cid.'.num'}.':classlist:'.
-                                       $url,$2,$end,$start).'<br>');
+                          &Apache::lonnet::escape($env{'form.ccuname'}.':'.
+                              $env{'form.ccdomain'}).'='.
+                          &Apache::lonnet::escape($now.':'),
+ 	                     $env{'course.'.$cid.'.home'}).'</b><br />');
+ 		}
+ 	    }
+ 	} elsif ($_=~/^form\.ren/) {
+             my $udom = $env{'form.ccdomain'};
+             my $uname = $env{'form.ccuname'};
+ 	    if ($_=~/^form\.ren\:([^\_]+)\_([^\_]+)$/) {
+                 my $url = $1;
+                 my $role = $2;
+                 my $logmsg;
+                 my $output;
+                 if ($role eq 'st') {
+                     if ($url =~ m-^/(\w+)/(\w+)/?(\w*)$-) {
+                         my $result = &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]: [_3]',
+ 			      $role,$url,$result).'<br />';
+ 		}
+                 $r->print($output);
+ 	    }
+ 	} elsif ($_=~/^form\.act/) {
+             my $udom = $env{'form.ccdomain'};
+             my $uname = $env{'form.ccuname'};
+ 	    if ($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_cr_cr_([^\_]+)_(\w+)_([^\_]+)$/) {
+                 # 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} :
+);
+                 # split multiple sections
+                 my %sections = ();
+                 my $num_sections = &build_roles($env{'form.sec_'.$full},\%sections,$5);
+                 if ($num_sections == 0) {
+                     $r->print(&commit_customrole($udom,$uname,$url,$three,$four,$five,$start,$end));
+                 } else {
+                     foreach (sort {$a cmp $b} keys %sections) {
+                         my $securl = $url.'/'.$_;
+ 		        $r->print(&commit_customrole($udom,$uname,$securl,$three,$four,$five,$start,$end));
+                     }
+                 }
+ 	    } elsif ($_=~/^form\.act\_([^\_]+)\_(\w+)\_([^\_]+)$/) {
+ 		# 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} :
+);
+ 		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(&commit_standardrole($udom,$uname,$url,$three,$start,$end,$one,$two,''));
+                 } else {
+                     my $emptysec = 0;
+                     foreach my $sec (sort {$a cmp $b} keys %sections) {
+                         $sec =~ s/\W//g;
+                         if ($sec ne '') {
+                             my $securl = $url.'/'.$sec;
+                             $r->print(&commit_standardrole($udom,$uname,$securl,$three,$start,$end,$one,$two,$sec));
+                         } else {
+                             $emptysec = 1;
+                         }
+                     }
+                     if ($emptysec) {
+                         $r->print(&commit_standardrole($udom,$uname,$url,$three,$start,$end,$one,$two,''));
+                     }
+                 }
+ 	    } elsif ($_=~/^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} :
+);
+ 		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(&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(&commit_standardrole($udom,$uname,$securl,$2,$start,$end,$1,undef,$sec));
+                         } else {
+                             $emptysec = 1;
+                         }
+                     }
+                     if ($emptysec) {
+                         $r->print(&commit_standardrole($udom,$uname,$url,$2,$start,$end,$1,undef,''));
+                     }
+                 }
+ 	    } else {
+ 		$r->print('<p>'.&mt('ERROR').': '.&mt('Unknown command').' <tt>'.$_.'</tt></p><br />');
+             }
+ 	}
+     } # End of foreach (keys(%env))
+ # Flush the course logs so reverse user roles immediately updated
+     &Apache::lonnet::flushcourselogs();
+     $r->print('<p><a href="/adm/createuser">Create/Modify Another User</a></p>');
+     $r->print('</body></html>');
+ }
+ sub commit_customrole {
+     my ($udom,$uname,$url,$three,$four,$five,$start,$end) = @_;
+     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.'@'.$three.' in '.$url.
+                          ($start?', '.&mt('starting').' '.localtime($start):'').
+                          ($end?', ending '.localtime($end):'').': <b>'.
+               &Apache::lonnet::assigncustomrole(
+                  $udom,$uname,$url,$three,$four,$five,$end,$start).
+                  '</b><br />';
+     return $output;
+ }
+ sub commit_standardrole {
+     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec) = @_;
+     my $output;
+     my $logmsg;
+     if ($three eq 'st') {
+         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec);
+         if (($result =~ /^error/) || ($result eq 'not_in_class') || ($result eq 'unknown_course')) {
+             $output = "Error: $result\n";
+         } else {
+             $output = &mt('Assigning').' '.$three.' in '.$url.
+                ($start?', '.&mt('starting').' '.localtime($start):'').
+                ($end?', '.&mt('ending').' '.localtime($end):'').
+                ': <b>'.$result.'</b><br />'.
+                &mt('Add to classlist').': <b>ok</b><br />';
+         }
+     } else {
+         $output = &mt('Assigning').' '.$three.' in '.$url.
+                ($start?', '.&mt('starting').' '.localtime($start):'').
+                ($end?', '.&mt('ending').' '.localtime($end):'').': <b>'.
+                &Apache::lonnet::assignrole(
+                    $udom,$uname,$url,$three,$end,$start).
+                    '</b><br />';
+     }
+     return $output;
+ }
+ sub commit_studentrole {
+     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec) = @_;
+     my $linefeed =  '<br />'."\n";
+     my $result;
+     if (defined($one) && defined($two)) {
+         my $cid=$one.'_'.$two;
+         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
+         my $secchange = 0;
+         my $expire_role_result;
+         my $modify_section_result;
+         unless ($oldsec eq '-1') {
+             unless ($sec eq $oldsec) {
+                 $secchange = 1;
+                 my $uurl='/'.$cid;
+                 $uurl=~s/\_/\//g;
+                 if ($oldsec) {
+                     $uurl.='/'.$oldsec;
+                 }
+                 $expire_role_result = &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',time);
+                 $result = $expire_role_result;
+             }
+         }
+         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
+             $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid);
+             if ($modify_section_result =~ /^ok/) {
+                 if ($secchange == 1) {
+                     $$logmsg .= "Section for $uname switched from old section: $oldsec to new section: $sec".$linefeed;
+                 } elsif ($oldsec eq '-1') {
+                     $$logmsg .= "New student role for $uname in section $sec in course $cid".$linefeed;
+                 } else {
+                     $$logmsg .= "Student $uname assigned to unchanged section $sec in course $cid".$linefeed;
+                 }
+             } else {
+                 $$logmsg .= "Error when attempting section change for $uname from old section $oldsec to new section: $sec in course $cid -error: $modify_section_result".$linefeed;
+             }
+             $result = $modify_section_result;
+         } elsif ($secchange == 1) {
+             $$logmsg .= "Error when attempting to expire role for $uname in old section $oldsec in course $cid -error: $expire_role_result".$linefeed;
+         }
+     } else {
+         $$logmsg .= "Incomplete course id defined.  Addition of user $uname from domain $udom to course $one\_$two, section $sec not completed.$linefeed";
+         $result = "Error: incomplete course id\n";
+     }
+     return $result;
+ }
+ sub build_roles {
+     my ($sectionstr,$sections,$role) = @_;
+     my $num_sections = 0;
+     if ($sectionstr=~ /,/) {
+         my @secnums = split/,/,$sectionstr;
+         if ($role eq 'st') {
+             $secnums[0] =~ s/\W//g;
+             $$sections{$secnums[0]} = 1;
+             $num_sections = 1;
+         } else {
+             foreach my $sec (@secnums) {
+                 $sec =~ ~s/\W//g;
+                 unless ($sec eq "") {
+                     if (exists($$sections{$sec})) {
+                         $$sections{$sec} ++;
+                     } else {
+                         $$sections{$sec} = 1;
+                         $num_sections ++;
+                     }
+                 }
+             }
          }
-     } keys %ENV;
+     } else {
+         $sectionstr=~s/\W//g;
+         unless ($sectionstr eq '') {
+             $$sections{$sectionstr} = 1;
+             $num_sections ++;
+         }
+     }
+     return $num_sections;
+ }
+ # ========================================================== Custom Role Editor
+ sub custom_role_editor {
+     my $r=shift;
+     my $rolename=$env{'form.rolename'};
+     if ($rolename eq 'make new role') {
+ 	$rolename=$env{'form.newrolename'};
+     }
+     $rolename=~s/[^A-Za-z0-9]//gs;
+     unless ($rolename) {
+ 	&print_username_entry_form($r);
+         return;
+     }
+     $r->print(&Apache::loncommon::bodytag(
+                      'Create Users, Change User Privileges').'<h2>');
+     my $syspriv='';
+     my $dompriv='';
+     my $coursepriv='';
+     my ($rdummy,$roledef)=
+ 			 &Apache::lonnet::get('roles',["rolesdef_$rolename"]);
+ # ------------------------------------------------------- Does this role exist?
+     if (($rdummy ne 'con_lost') && ($roledef ne '')) {
+ 	$r->print(&mt('Existing Role').' "');
+ # ------------------------------------------------- Get current role privileges
+ 	($syspriv,$dompriv,$coursepriv)=split(/\_/,$roledef);
+     } else {
+ 	$r->print(&mt('New Role').' "');
+ 	$roledef='';
+     }
+     $r->print($rolename.'"</h2>');
+ # ------------------------------------------------------- What can be assigned?
+     my %full=();
+     my %courselevel=();
+     my %courselevelcurrent=();
+     foreach (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
+ 	my ($priv,$restrict)=split(/\&/,$_);
+         unless ($restrict) { $restrict='F'; }
+         $courselevel{$priv}=$restrict;
+         if ($coursepriv=~/\:$priv/) {
+ 	    $courselevelcurrent{$priv}=1;
+ 	}
+ 	$full{$priv}=1;
+     }
+     my %domainlevel=();
+     my %domainlevelcurrent=();
+     foreach (split(/\:/,$Apache::lonnet::pr{'cr:d'})) {
+ 	my ($priv,$restrict)=split(/\&/,$_);
+         unless ($restrict) { $restrict='F'; }
+         $domainlevel{$priv}=$restrict;
+         if ($dompriv=~/\:$priv/) {
+ 	    $domainlevelcurrent{$priv}=1;
+ 	}
+ 	$full{$priv}=1;
+     }
+     my %systemlevel=();
+     my %systemlevelcurrent=();
+     foreach (split(/\:/,$Apache::lonnet::pr{'cr:s'})) {
+ 	my ($priv,$restrict)=split(/\&/,$_);
+         unless ($restrict) { $restrict='F'; }
+         $systemlevel{$priv}=$restrict;
+         if ($syspriv=~/\:$priv/) {
+ 	    $systemlevelcurrent{$priv}=1;
+ 	}
+ 	$full{$priv}=1;
+     }
+     my %lt=&Apache::lonlocal::texthash(
+ 		    'prv'  => "Privilege",
+ 		    'crl'  => "Course Level",
+                     'dml'  => "Domain Level",
+                     'ssl'  => "System Level"
+ 				       );
+     $r->print(<<ENDCCF);
+ <form method="post">
+ <input type="hidden" name="phase" value="set_custom_roles" />
+ <input type="hidden" name="rolename" value="$rolename" />
+ <table border="2">
+ <tr><th>$lt{'prv'}</th><th>$lt{'crl'}</th><th>$lt{'dml'}</th>
+ <th>$lt{'ssl'}</th></tr>
+ ENDCCF
+     foreach (sort keys %full) {
+ 	$r->print('<tr><td>'.&Apache::lonnet::plaintext($_).'</td><td>'.
+     ($courselevel{$_}?'<input type="checkbox" name="'.$_.':c" '.
+     ($courselevelcurrent{$_}?'checked="1"':'').' />':'&nbsp;').
+     '</td><td>'.
+     ($domainlevel{$_}?'<input type="checkbox" name="'.$_.':d" '.
+     ($domainlevelcurrent{$_}?'checked="1"':'').' />':'&nbsp;').
+     '</td><td>'.
+     ($systemlevel{$_}?'<input type="checkbox" name="'.$_.':s" '.
+     ($systemlevelcurrent{$_}?'checked="1"':'').' />':'&nbsp;').
+     '</td></tr>');
+     }
+     $r->print(
+    '<table><input type="submit" value="'.&mt('Define Role').'" /></form></body></html>');
+ }
+ # ---------------------------------------------------------- Call to definerole
+ sub set_custom_role {
+     my $r=shift;
+     my $rolename=$env{'form.rolename'};
+     $rolename=~s/[^A-Za-z0-9]//gs;
+     unless ($rolename) {
+ 	&print_username_entry_form($r);
+         return;
+     }
+     $r->print(&Apache::loncommon::bodytag(
+                      'Create Users, Change User Privileges').'<h2>');
+     my ($rdummy,$roledef)=
+ 			 &Apache::lonnet::get('roles',["rolesdef_$rolename"]);
+ # ------------------------------------------------------- Does this role exist?
+     if (($rdummy ne 'con_lost') && ($roledef ne '')) {
+ 	$r->print(&mt('Existing Role').' "');
+     } else {
+ 	$r->print(&mt('New Role').' "');
+ 	$roledef='';
+     }
+     $r->print($rolename.'"</h2>');
+ # ------------------------------------------------------- What can be assigned?
+     my $sysrole='';
+     my $domrole='';
+     my $courole='';
+     foreach (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
+ 	my ($priv,$restrict)=split(/\&/,$_);
+         unless ($restrict) { $restrict=''; }
+         if ($env{'form.'.$priv.':c'}) {
+ 	    $courole.=':'.$_;
+ 	}
+     }
+     foreach (split(/\:/,$Apache::lonnet::pr{'cr:d'})) {
+ 	my ($priv,$restrict)=split(/\&/,$_);
+         unless ($restrict) { $restrict=''; }
+         if ($env{'form.'.$priv.':d'}) {
+ 	    $domrole.=':'.$_;
+ 	}
+     }
+     foreach (split(/\:/,$Apache::lonnet::pr{'cr:s'})) {
+ 	my ($priv,$restrict)=split(/\&/,$_);
+         unless ($restrict) { $restrict=''; }
+         if ($env{'form.'.$priv.':s'}) {
+ 	    $sysrole.=':'.$_;
+ 	}
+     }
+     $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('</body></html>');
  }
- Line 411  sub handler {
+ Line 1558  sub handler {
      my $r = shift;
      if ($r->header_only) {
-        $r->content_type('text/html');
+        &Apache::loncommon::content_type($r,'text/html');
         $r->send_http_header;
         return OK;
      }
-     if ((&Apache::lonnet::allowed('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;
-        unless ($ENV{'form.phase'}) {
+        unless ($env{'form.phase'}) {
- 	   &phase_one($r);
+ 	   &print_username_entry_form($r);
         }
-        if ($ENV{'form.phase'} eq 'two') {
+        if ($env{'form.phase'} eq 'get_user_info') {
-            &phase_two($r);
+            &print_user_modification_page($r);
-        } elsif ($ENV{'form.phase'} eq 'three') {
+        } elsif ($env{'form.phase'} eq 'update_user_data') {
-            &phase_three($r);
+            &update_user_data($r);
+        } elsif ($env{'form.phase'} eq 'selected_custom_edit') {
+            &custom_role_editor($r);
+        } elsif ($env{'form.phase'} eq 'set_custom_roles') {
+ 	   &set_custom_role($r);
         }
     } else {
-       $ENV{'user.error.msg'}=
+       $env{'user.error.msg'}=
          "/adm/createuser:mau:0:0:Cannot modify user data";
        return HTTP_NOT_ACCEPTABLE;
     }
     return OK;
  }
+ #-------------------------------------------------- functions for &phase_two
+ sub course_level_table {
+     my (%inccourses) = @_;
+     my $table = '';
+ # Custom Roles?
+     my %customroles=&my_custom_roles();
+     my %lt=&Apache::lonlocal::texthash(
+             'exs'  => "Existing sections",
+             'new'  => "Define new section",
+             'ssd'  => "Set Start Date",
+             'sed'  => "Set End Date",
+             'crl'  => "Course Level",
+             'act'  => "Activate",
+             'rol'  => "Role",
+             'ext'  => "Extent",
+             'grs'  => "Group/Section",
+             'sta'  => "Start",
+             'end'  => "End"
+     );
+     foreach (sort( keys(%inccourses))) {
+ 	my $thiscourse=$_;
+ 	my $protectedcourse=$_;
+ 	$thiscourse=~s:_:/:g;
+ 	my %coursedata=&Apache::lonnet::coursedescription($thiscourse);
+ 	my $area=$coursedata{'description'};
+ 	if (!defined($area)) { $area=&mt('Unavailable course').': '.$_; }
+ 	my $bgcol=$thiscourse;
+ 	$bgcol=~s/[^7-9a-e]//g;
+ 	$bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',2,6);
+ 	my ($domain,$cnum)=split(/\//,$thiscourse);
+         my %sections_count = ();
+         my $num_sections = 0;
+         if (defined($env{'request.course.id'})) {
+             if ($env{'request.course.id'} eq $domain.'_'.$cnum) {
+                 $num_sections = &Apache::loncommon::get_sections($domain,$cnum,\%sections_count);
+             }
+         }
+ 	foreach  ('st','ta','ep','ad','in','cc') {
+ 	    if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) {
+ 		my $plrole=&Apache::lonnet::plaintext($_);
+ 		$table .= <<ENDEXTENT;
+ <tr bgcolor="#$bgcol">
+ <td><input type="checkbox" name="act_$protectedcourse\_$_"></td>
+ <td>$plrole</td>
+ <td>$area<br />Domain: $domain</td>
+ ENDEXTENT
+ 	        if ($_ ne 'cc') {
+                     if ($num_sections > 0) {
+                         my $currsec = &course_sections($num_sections,\%sections_count,$protectedcourse.'_'.$_);
+                         $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_'.$protectedcourse.'_'.$_.'" value="" /></td>'.
+                      '<input type="hidden" '.
+                      'name="sec_'.$protectedcourse.'_'.$_.'"></td>'.
+                      '</tr></table></td>';
+                     } else {
+                         $table .= '<td><input type="text" size="10" '.
+                      'name="sec_'.$protectedcourse.'_'.$_.'"></td>';
+                     }
+                 } else {
+ 		    $table .= '<td>&nbsp</td>';
+                 }
+ 		$table .= <<ENDTIMEENTRY;
+ <td><input type=hidden name="start_$protectedcourse\_$_" value=''>
+ <a href=
+ "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$_.value,'start_$protectedcourse\_$_','cu.pres','dateset')">$lt{'ssd'}</a></td>
+ <td><input type=hidden name="end_$protectedcourse\_$_" value=''>
+ <a href=
+ "javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$_.value,'end_$protectedcourse\_$_','cu.pres','dateset')">$lt{'sed'}</a></td>
+ ENDTIMEENTRY
+                 $table.= "</tr>\n";
+             }
+         }
+         foreach (sort keys %customroles) {
+ 	    if (&Apache::lonnet::allowed('ccr',$thiscourse)) {
+ 		my $plrole=$_;
+                 my $customrole=$protectedcourse.'_cr_cr_'.$env{'user.domain'}.
+ 		    '_'.$env{'user.name'}.'_'.$plrole;
+ 		$table .= <<END;
+ <tr bgcolor="#$bgcol">
+ <td><input type="checkbox" name="act_$customrole"></td>
+ <td>$plrole</td>
+ <td>$area</td>
+ END
+                 if ($num_sections > 0) {
+                     my $currsec = &course_sections($num_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></tr>
+ ENDENTRY
+            }
+ 	}
+     }
+     return '' if ($table eq ''); # return nothing if there is nothing
+                                  # in the table
+     my $result = <<ENDTABLE;
+ <h4>$lt{'crl'}</h4>
+ <table border=2><tr><th>$lt{'act'}</th><th>$lt{'rol'}</th><th>$lt{'ext'}</th>
+ <th>$lt{'grs'}</th><th>$lt{'sta'}</th><th>$lt{'end'}</th></tr>
+ $table
+ </table>
+ ENDTABLE
+     return $result;
+ }
+ sub course_sections {
+     my ($num_sections,$sections_count,$role) = @_;
+     my $output = '';
+     my @sections = (sort {$a <=> $b} keys %{$sections_count});
+     if ($num_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 ($num_sections <4) { $multiple = $num_sections; }
+         $output .= '"multiple" size="'.$multiple.'">'."\n";
+         foreach (@sections) {
+             $output .= '<option value="'.$_.'">'.$_."</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').'</b>';
+     my $cb_jscript = &Apache::loncommon::coursebrowser_javascript($dcdom,$dcdom);
+     my %lt=&Apache::lonlocal::texthash(
+                     'crl'  => "Course Level",
+                     'crt'  => "Course Title",
+                     'rol'  => "Role",
+                     'grs'  => "Group/Section",
+                     'exs'  => "Existing sections",
+                     'new'  => "Define new section",
+                     'sta'  => "Start",
+                     'end'  => "End",
+                     'ssd'  => "Set Start Date",
+                     'sed'  => "Set End Date"
+                   );
+     my $header = '<h4>'.$lt{'crl'}.'</h4>'.
+                  '<table border="2"><tr><th>'.$courseform.'</th><th>'.$lt{'rol'}.'</th><th>'.$lt{'grs'}.'</th><th>'.$lt{'sta'}.'</th><th>'.$lt{'end'}.'</th></tr>';
+     my $otheritems = '<tr><td><input type="text" name="coursedesc" value="" onFocus="this.blur();opencrsbrowser('."'".'cu'."'".','."'".'dccourse'."'".','."'".'dcdomain'."'".','."'".'coursedesc'."',''".')" /></td>'.
+                      '<td><select name="role">'."\n";
+     foreach  ('st','ta','ep','ad','in','cc') {
+         my $plrole=&Apache::lonnet::plaintext($_);
+         $otheritems .= '  <option value="'.$_.'">'.$plrole;
+     }
+     if ( keys %customroles > 0) {
+         foreach (sort keys %customroles) {
+             my $custrole='cr_cr_'.$env{'user.domain'}.
+                     '_'.$env{'user.name'}.'_'.$_;
+             $otheritems .= '  <option value="'.$custrole.'">'.$_;
+         }
+     }
+     $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="" /></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 .= "</tr></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
 ;
  __END__

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

Removed from v.1.12
changed lines
	Added in v.1.106