[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm

[raeburn]

raeburn		Mon Mar  9 03:49:18 2009 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  &retrieve_inst_usertypes() will retrieve hashref (usertypes) and arrayref (typesorder) from cached domain defaults for inststatustypes and inststatusorder, if available.
  
  &get_domain_defaults() will retrieve/cache additional defaults: for course resquest config ('official' and 'unofficial') and inststitutional status types ('inststatustypes' and 'inststatusorder').
  
  &modifyuser() will check if proposed institutional status(es) for a user is/are defined in the user's domain before updating user's environment.db
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.988 loncom/lonnet/perl/lonnet.pm:1.989
--- loncom/lonnet/perl/lonnet.pm:1.988	Sun Mar  1 01:12:23 2009
+++ loncom/lonnet/perl/lonnet.pm	Mon Mar  9 03:49:17 2009
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.988 2009/03/01 01:12:23 raeburn Exp $
+# $Id: lonnet.pm,v 1.989 2009/03/09 03:49:17 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1005,27 +1005,34 @@
 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);
 }
@@ -1262,7 +1269,8 @@
     }
     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'};
@@ -1292,6 +1300,11 @@
             $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;
@@ -5902,7 +5915,21 @@
        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);