Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.988 and 1.989

version 1.988, 2009/03/01 01:12:23 version 1.989, 2009/03/09 03:49:17
Line 1005  sub put_dom { Line 1005  sub put_dom {
 sub retrieve_inst_usertypes {  sub retrieve_inst_usertypes {
     my ($udom) = @_;      my ($udom) = @_;
     my (%returnhash,@order);      my (%returnhash,@order);
     if (defined(&domain($udom,'primary'))) {      my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
         my $uhome=&domain($udom,'primary');      if ((ref($domdefs{'inststatustypes'}) eq 'HASH') && 
         my $rep=&reply("inst_usertypes:$udom",$uhome);          (ref($domdefs{'inststatusorder'}) eq 'ARRAY')) {
         if ($rep =~ /^(con_lost|error|no_such_host|refused)/) {          %returnhash = %{$domdefs{'inststatustypes'}};
             &logthis("get_dom failed - $rep returned from $uhome in domain: $udom");          @order = @{$domdefs{'inststatusorder'}};
             return (\%returnhash,\@order);      } else {
         }          if (defined(&domain($udom,'primary'))) {
         my ($hashitems,$orderitems) = split(/:/,$rep);               my $uhome=&domain($udom,'primary');
         my @pairs=split(/\&/,$hashitems);              my $rep=&reply("inst_usertypes:$udom",$uhome);
         foreach my $item (@pairs) {              if ($rep =~ /^(con_lost|error|no_such_host|refused)/) {
             my ($key,$value)=split(/=/,$item,2);                  &logthis("get_dom failed - $rep returned from $uhome in domain: $udom");
             $key = &unescape($key);                  return (\%returnhash,\@order);
             next if ($key =~ /^error: 2 /);              }
             $returnhash{$key}=&thaw_unescape($value);              my ($hashitems,$orderitems) = split(/:/,$rep); 
         }              my @pairs=split(/\&/,$hashitems);
         my @esc_order = split(/\&/,$orderitems);              foreach my $item (@pairs) {
         foreach my $item (@esc_order) {                  my ($key,$value)=split(/=/,$item,2);
             push(@order,&unescape($item));                  $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");
         }          }
     } else {  
         &logthis("get_dom failed - no primary domain server for $udom");  
     }      }
     return (\%returnhash,\@order);      return (\%returnhash,\@order);
 }  }
Line 1262  sub get_domain_defaults { Line 1269  sub get_domain_defaults {
     }      }
     my %domdefaults;      my %domdefaults;
     my %domconfig =      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') {      if (ref($domconfig{'defaults'}) eq 'HASH') {
         $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};           $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; 
         $domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};          $domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};
Line 1292  sub get_domain_defaults { Line 1300  sub get_domain_defaults {
             $domdefaults{$item} = $domconfig{'requestcourses'}{$item};              $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,      &Apache::lonnet::do_cache_new('domdefaults',$domain,\%domdefaults,
                                   $cachetime);                                    $cachetime);
     return %domdefaults;      return %domdefaults;
Line 5902  sub modifyuser { Line 5915  sub modifyuser {
        if ($email=~/\@/) { $names{'permanentemail'} = $email; }         if ($email=~/\@/) { $names{'permanentemail'} = $email; }
     }      }
     if ($uid) { $names{'id'}  = $uid; }      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);      my $reply = &put('environment', \%names, $udom,$uname);
     if ($reply ne 'ok') { return 'error: '.$reply; }      if ($reply ne 'ok') { return 'error: '.$reply; }
     my $sqlresult = &update_allusers_table($uname,$udom,\%names);      my $sqlresult = &update_allusers_table($uname,$udom,\%names);

Removed from v.1.988  
changed lines
  Added in v.1.989


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