--- loncom/lonnet/perl/lonnet.pm	2009/02/10 11:15:16	1.986
+++ loncom/lonnet/perl/lonnet.pm	2009/03/21 20:56:55	1.991
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.986 2009/02/10 11:15:16 foxr Exp $
+# $Id: lonnet.pm,v 1.991 2009/03/21 20:56:55 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -74,9 +74,7 @@ use strict;
 use LWP::UserAgent();
 use HTTP::Date;
 use Image::Magick;
-use IO::Socket;
 
-# use Date::Parse;
 use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
             $_64bit %env %protocol);
 
@@ -528,7 +526,7 @@ sub appenv {
 # ----------------------------------------------------- Delete from Environment
 
 sub delenv {
-    my $delthis=shift;
+    my ($delthis,$regexp) = @_;
     if (($delthis=~/user\.role/) || ($delthis=~/user\.priv/)) {
         &logthis("<font color=\"blue\">WARNING: ".
                 "Attempt to delete from environment ".$delthis);
@@ -541,10 +539,17 @@ sub delenv {
 	tie(my %disk_env,'GDBM_File',$env{'user.environment'},
 	    (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) {
 	foreach my $key (keys(%disk_env)) {
-	    if ($key=~/^\Q$delthis\E/) { 
-		delete($env{$key});
-		delete($disk_env{$key});
-	    }
+	    if ($regexp) {
+                if ($key=~/^$delthis/) {
+                    delete($env{$key});
+                    delete($disk_env{$key});
+                } 
+            } else {
+                if ($key=~/^\Q$delthis\E/) {
+		    delete($env{$key});
+		    delete($disk_env{$key});
+	        }
+            }
 	}
 	untie(%disk_env);
     }
@@ -998,27 +1003,34 @@ sub put_dom {
 sub retrieve_inst_usertypes {
     my ($udom) = @_;
     my (%returnhash,@order);
-    if (defined(&domain($udom,'primary'))) {
-        my $uhome=&domain($udom,'primary');
-        my $rep=&reply("inst_usertypes:$udom",$uhome);
-        if ($rep =~ /^(con_lost|error|no_such_host|refused)/) {
-            &logthis("get_dom failed - $rep returned from $uhome in domain: $udom");
-            return (\%returnhash,\@order);
-        }
-        my ($hashitems,$orderitems) = split(/:/,$rep); 
-        my @pairs=split(/\&/,$hashitems);
-        foreach my $item (@pairs) {
-            my ($key,$value)=split(/=/,$item,2);
-            $key = &unescape($key);
-            next if ($key =~ /^error: 2 /);
-            $returnhash{$key}=&thaw_unescape($value);
-        }
-        my @esc_order = split(/\&/,$orderitems);
-        foreach my $item (@esc_order) {
-            push(@order,&unescape($item));
-        }
+    my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
+    if ((ref($domdefs{'inststatustypes'}) eq 'HASH') && 
+        (ref($domdefs{'inststatusorder'}) eq 'ARRAY')) {
+        %returnhash = %{$domdefs{'inststatustypes'}};
+        @order = @{$domdefs{'inststatusorder'}};
     } else {
-        &logthis("get_dom failed - no primary domain server for $udom");
+        if (defined(&domain($udom,'primary'))) {
+            my $uhome=&domain($udom,'primary');
+            my $rep=&reply("inst_usertypes:$udom",$uhome);
+            if ($rep =~ /^(con_lost|error|no_such_host|refused)/) {
+                &logthis("get_dom failed - $rep returned from $uhome in domain: $udom");
+                return (\%returnhash,\@order);
+            }
+            my ($hashitems,$orderitems) = split(/:/,$rep); 
+            my @pairs=split(/\&/,$hashitems);
+            foreach my $item (@pairs) {
+                my ($key,$value)=split(/=/,$item,2);
+                $key = &unescape($key);
+                next if ($key =~ /^error: 2 /);
+                $returnhash{$key}=&thaw_unescape($value);
+            }
+            my @esc_order = split(/\&/,$orderitems);
+            foreach my $item (@esc_order) {
+                push(@order,&unescape($item));
+            }
+        } else {
+            &logthis("get_dom failed - no primary domain server for $udom");
+        }
     }
     return (\%returnhash,\@order);
 }
@@ -1255,7 +1267,8 @@ sub get_domain_defaults {
     }
     my %domdefaults;
     my %domconfig =
-         &Apache::lonnet::get_dom('configuration',['defaults','quotas'],$domain);
+         &Apache::lonnet::get_dom('configuration',['defaults','quotas',
+                                  'requestcourses','inststatus'],$domain);
     if (ref($domconfig{'defaults'}) eq 'HASH') {
         $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; 
         $domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};
@@ -1285,6 +1298,11 @@ sub get_domain_defaults {
             $domdefaults{$item} = $domconfig{'requestcourses'}{$item};
         }
     }
+    if (ref($domconfig{'inststatus'}) eq 'HASH') {
+        foreach my $item ('inststatustypes','inststatusorder') {
+            $domdefaults{$item} = $domconfig{'inststatus'}{$item};
+        }
+    }
     &Apache::lonnet::do_cache_new('domdefaults',$domain,\%domdefaults,
                                   $cachetime);
     return %domdefaults;
@@ -2670,6 +2688,7 @@ sub get_course_adv_roles {
     my ($cid,$codes) = @_;
     $cid=$env{'request.course.id'} unless (defined($cid));
     my %coursehash=&coursedescription($cid);
+    my $crstype = &Apache::loncommon::course_type($cid);
     my %nothide=();
     foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
         if ($user !~ /:/) {
@@ -2700,7 +2719,7 @@ sub get_course_adv_roles {
                 $returnhash{$role}=$username.':'.$domain;
             }
         } else {
-            my $key=&plaintext($role);
+            my $key=&plaintext($role,$crstype);
             if ($section) { $key.=' ('.&Apache::lonlocal::mt('Section [_1]',$section).')'; }
             if ($returnhash{$key}) {
 	        $returnhash{$key}.=','.$username.':'.$domain;
@@ -5661,16 +5680,19 @@ sub devalidate_getgroups_cache {
 # ------------------------------------------------------------------ Plain Text
 
 sub plaintext {
-    my ($short,$type,$cid) = @_;
+    my ($short,$type,$cid,$forcedefault) = @_;
     if ($short =~ /^cr/) {
 	return (split('/',$short))[-1];
     }
     if (!defined($cid)) {
         $cid = $env{'request.course.id'};
     }
-    if (defined($cid) && defined($env{'course.'.$cid.'.'.$short.'.plaintext'})) {
-        return &Apache::lonlocal::mt($env{'course.'.$cid.'.'.$short.
-                                          '.plaintext'});
+    if (defined($cid) && ($env{'course.'.$cid.'.'.$short.'.plaintext'} ne '')) {
+        unless ($forcedefault) {
+            my $roletext = $env{'course.'.$cid.'.'.$short.'.plaintext'}; 
+            &Apache::lonlocal::mt_escape(\$roletext);
+            return &Apache::lonlocal::mt($roletext);
+        }
     }
     my %rolenames = (
                       Course => 'std',
@@ -5891,7 +5913,21 @@ sub modifyuser {
        if ($email=~/\@/) { $names{'permanentemail'} = $email; }
     }
     if ($uid) { $names{'id'}  = $uid; }
-    if (defined($inststatus)) { $names{'inststatus'} = $inststatus; } 
+    if (defined($inststatus)) {
+        $names{'inststatus'} = '';
+        my ($usertypes,$typesorder) = &retrieve_inst_usertypes($udom);
+        if (ref($usertypes) eq 'HASH') {
+            my @okstatuses; 
+            foreach my $item (split(/:/,$inststatus)) {
+                if (defined($usertypes->{$item})) {
+                    push(@okstatuses,$item);  
+                }
+            }
+            if (@okstatuses) {
+                $names{'inststatus'} = join(':', map { &escape($_); } @okstatuses);
+            }
+        }
+    }
     my $reply = &put('environment', \%names, $udom,$uname);
     if ($reply ne 'ok') { return 'error: '.$reply; }
     my $sqlresult = &update_allusers_table($uname,$udom,\%names);
@@ -5913,7 +5949,7 @@ sub modifyuser {
 sub modifystudent {
     my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
         $end,$start,$forceid,$desiredhome,$email,$type,$locktype,$cid,
-        $selfenroll,$context)=@_;
+        $selfenroll,$context,$inststatus)=@_;
     if (!$cid) {
 	unless ($cid=$env{'request.course.id'}) {
 	    return 'not_in_class';
@@ -5922,7 +5958,7 @@ sub modifystudent {
 # --------------------------------------------------------------- Make the user
     my $reply=&modifyuser
 	($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid,
-         $desiredhome,$email);
+         $desiredhome,$email,$inststatus);
     unless ($reply eq 'ok') { return $reply; }
     # This will cause &modify_student_enrollment to get the uid from the
     # students environment
@@ -9308,9 +9344,11 @@ in the user's environment.db and in %env
 
 =item *
 X<delenv()>
-B<delenv($regexp)>: removes all items from the session
-environment file that matches the regular expression in $regexp. The
-values are also delted from the current processes %env.
+B<delenv($delthis,$regexp)>: removes all items from the session
+environment file that begin with $delthis. If the 
+optional second arg - $regexp - is true, $delthis is treated as a 
+regular expression, otherwise \Q$delthis\E is used. 
+The values are also deleted from the current processes %env.
 
 =item * get_env_multiple($name) 
 
@@ -9407,9 +9445,14 @@ and course level
 
 =item *
 
-plaintext($short) : return value in %prp hash (rolesplain.tab); plain text
-explanation of a user role term
-
+plaintext($short,$type,$cid,$forcedefault) : return value in %prp hash 
+(rolesplain.tab); plain text explanation of a user role term.
+$type is Course (default) or Group.
+If $forcedefault evaluates to true, text returned will be default 
+text for $type. Otherwise, if this is a course, the text returned 
+will be a custom name for the role (if defined in the course's 
+environment).  If no custom name is defined the default is returned.
+   
 =item *
 
 get_my_roles($uname,$udom,$context,$types,$roles,$roledoms,$withsec) :