[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1125 and 1.1128

version 1.1125, 2011/08/05 04:35:50 version 1.1128, 2011/08/09 01:06:33
Line 1142  sub spare_can_host { Line 1142  sub spare_can_host {
   
 sub this_host_spares {  sub this_host_spares {
     my ($dom) = @_;      my ($dom) = @_;
     my $cachetime = 60*60*24;      my ($dom_in_use,$lonhost_in_use,$result);
     my @hosts = &current_machine_ids();      my @hosts = &current_machine_ids();
     foreach my $lonhost (@hosts) {      foreach my $lonhost (@hosts) {
         if (&host_domain($lonhost) eq $dom) {          if (&host_domain($lonhost) eq $dom) {
             my ($result,$cached)=&is_cached_new('spares',$dom);              $dom_in_use = $dom;
             if (defined($cached)) {              $lonhost_in_use = $lonhost;
                 return $result;  
             } else {  
                 my %domconfig =  
                     &Apache::lonnet::get_dom('configuration',['usersessions'],$dom);  
                 if (ref($domconfig{'usersessions'}) eq 'HASH') {  
                     if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') {  
                         if (ref($domconfig{'usersessions'}{'spares'}{$lonhost}) eq 'HASH') {  
                             return &do_cache_new('spares',$dom,$domconfig{'usersessions'}{'spares'}{$lonhost},$cachetime);  
                         }  
                     }  
                 }  
             }  
             last;              last;
         }          }
     }      }
     my $serverhomedom = &host_domain($perlvar{'lonHostID'});      if ($dom_in_use ne '') {
     my ($result,$cached)=&is_cached_new('spares',$serverhomedom);          $result = &spares_for_offload($dom_in_use,$lonhost_in_use);
       }
       if (ref($result) ne 'HASH') {
           $lonhost_in_use = $perlvar{'lonHostID'};
           $dom_in_use = &host_domain($lonhost_in_use);
           $result = &spares_for_offload($dom_in_use,$lonhost_in_use);
           if (ref($result) ne 'HASH') {
               $result = \%spareid;
           }
       }
       return $result;
   }
   
   sub spares_for_offload  {
       my ($dom_in_use,$lonhost_in_use) = @_;
       my ($result,$cached)=&is_cached_new('spares',$dom_in_use);
     if (defined($cached)) {      if (defined($cached)) {
         return $result;          return $result;
     } else {      } else {
         my %homedomconfig =          my $cachetime = 60*60*24;
             &Apache::lonnet::get_dom('configuration',['usersessions'],$serverhomedom);          my %domconfig =
         if (ref($homedomconfig{'usersessions'}) eq 'HASH') {              &Apache::lonnet::get_dom('configuration',['usersessions'],$dom_in_use);
             if (ref($homedomconfig{'usersessions'}{'spares'}) eq 'HASH') {          if (ref($domconfig{'usersessions'}) eq 'HASH') {
                 if (ref($homedomconfig{'usersessions'}{'spares'}{$perlvar{'lonHostID'}}) eq 'HASH') {              if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') {
                     return &do_cache_new('spares',$serverhomedom,$homedomconfig{'usersessions'}{'spares'}{$perlvar{'lonHostID'}},$cachetime);                  if (ref($domconfig{'usersessions'}{'spares'}{$lonhost_in_use}) eq 'HASH') {
                       return &do_cache_new('spares',$dom_in_use,$domconfig{'usersessions'}{'spares'}{$lonhost_in_use},$cachetime);
                 }                  }
             }              }
         }          }
     }      }
     return \%spareid;      return;
   }
   
   sub internet_dom_servers {
       my ($dom) = @_;
       my (%uniqservers,%servers);
       my $primaryserver = &hostname(&domain($dom,'primary'));
       my @machinedoms = &machine_domains($primaryserver);
       foreach my $mdom (@machinedoms) {
           my %currservers = %servers;
           my %server = &get_servers($mdom);
           %servers = (%currservers,%server);
       }
       my %by_hostname;
       foreach my $id (keys(%servers)) {
           push(@{$by_hostname{$servers{$id}}},$id);
       }
       foreach my $hostname (sort(keys(%by_hostname))) {
           if (@{$by_hostname{$hostname}} > 1) {
               my $match = 0;
               foreach my $id (@{$by_hostname{$hostname}}) {
                   if (&host_domain($id) eq $dom) {
                       $uniqservers{$id} = $hostname;
                       $match = 1;
                   }
               }
               unless ($match) {
                   $uniqservers{$by_hostname{$hostname}[0]} = $hostname;
               }
           } else {
               $uniqservers{$by_hostname{$hostname}[0]} = $hostname;
           }
       }
       return %uniqservers;
 }  }
   
 # ---------------------- Find the homebase for a user from domain's lib servers  # ---------------------- Find the homebase for a user from domain's lib servers
Line 5341  sub is_advanced_user { Line 5378  sub is_advanced_user {
     my ($udom,$uname) = @_;      my ($udom,$uname) = @_;
     if ($udom ne '' && $uname ne '') {      if ($udom ne '' && $uname ne '') {
         if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {          if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
             return $env{'user.adv'};                if (wantarray) {
                   return ($env{'user.adv'},$env{'user.author'});
               } else {
                   return $env{'user.adv'};
               }
         }          }
     }      }
     my %roleshash = &get_my_roles($uname,$udom,'userroles',undef,undef,undef,1);      my %roleshash = &get_my_roles($uname,$udom,'userroles',undef,undef,undef,1);
     my %allroles;      my %allroles;
     my $is_adv;      my ($is_adv,$is_author);
     foreach my $role (keys(%roleshash)) {      foreach my $role (keys(%roleshash)) {
         my ($trest,$tdomain,$trole,$sec) = split(/:/,$role);          my ($trest,$tdomain,$trole,$sec) = split(/:/,$role);
         my $area = '/'.$tdomain.'/'.$trest;          my $area = '/'.$tdomain.'/'.$trest;
Line 5360  sub is_advanced_user { Line 5401  sub is_advanced_user {
             } elsif ($trole ne 'gr') {              } elsif ($trole ne 'gr') {
                 &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);                  &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
             }              }
               if ($trole eq 'au') {
                   $is_author = 1;
               }
         }          }
     }      }
     foreach my $role (keys(%allroles)) {      foreach my $role (keys(%allroles)) {
Line 5374  sub is_advanced_user { Line 5418  sub is_advanced_user {
             }              }
         }          }
     }      }
       if (wantarray) {
           return ($is_adv,$is_author);
       }
     return $is_adv;      return $is_adv;
 }  }
   
Removed from v.1.1125  
changed lines
  Added in v.1.1128

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