Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.862 and 1.865

version 1.862, 2007/04/04 00:07:07 version 1.865, 2007/04/04 18:01:11
Line 671  sub homeserver { Line 671  sub homeserver {
     return 'no_host';      return 'no_host';
 }  }
   
 # ---------------------- Get domain configuration for a domain  
 sub get_domainconf {  
     my ($udom) = @_;  
     my $cachetime=1800;  
     my ($result,$cached)=&is_cached_new('domainconfig',$udom);  
     if (defined($cached)) { return %{$result}; }  
   
     if ($udom eq '') {  
         $udom = &Apache::loncommon::determinedomain();  
     }  
     my %domconfig = &get_dom('configuration',['login','rolecolors'],$udom);  
     my %designhash;  
     if (keys(%domconfig) > 0) {  
         if (ref($domconfig{'login'}) eq 'HASH') {  
             foreach my $key (keys(%{$domconfig{'login'}})) {  
                 $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};  
             }  
         }  
         if (ref($domconfig{'rolecolors'}) eq 'HASH') {  
             foreach my $role (keys(%{$domconfig{'rolecolors'}})) {  
                 if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {  
                     foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {  
                         $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};  
                     }  
                 }  
             }  
         }  
     } else {  
         my $designdir=$perlvar{'lonTabDir'}.'/lonDomColors';  
         my $designfile =  $designdir.'/'.$udom.'.tab';  
         if (-e $designfile) {  
             if ( open (my $fh,"<$designfile") ) {  
                 while (my $line = <$fh>) {  
                     next if ($line =~ /^\#/);  
                     chomp($line);  
                     my ($key,$val)=(split(/\=/,$line));  
                     if ($val) { $designhash{$udom.'.'.$key}=$val; }  
                 }  
                 close($fh);  
             }  
         }  
         if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {  
             $designhash{$udom.'.login.domlogo'} =   
                 &lonhttpdurl("/adm/lonDomLogos/$udom.gif");   
         }  
     }  
     &do_cache_new('domainconfig',$udom,\%designhash,$cachetime);  
     return %designhash;  
 }  
   
 sub devalidate_domconfig_cache {  
     my ($udom)=@_;  
     &devalidate_cache_new('domainconfig',$udom);  
 }  
   
 # ------------------------------------- Find the usernames behind a list of IDs  # ------------------------------------- Find the usernames behind a list of IDs
   
 sub idget {  sub idget {
Line 3641  sub get_portfolio_access { Line 3586  sub get_portfolio_access {
             }              }
             if (@users > 0) {              if (@users > 0) {
                 foreach my $userkey (@users) {                  foreach my $userkey (@users) {
                     if (exists($access_hash->{$userkey}{'users'}{$env{'user.name'}.':'.$env{'user.domain'}})) {                      if (ref($access_hash->{$userkey}{'users'}) eq 'ARRAY') {
                         return 'ok';                          foreach my $item (@{$access_hash->{$userkey}{'users'}}) {
                     }                              if (ref($item) eq 'HASH') {
                                   if (($item->{'uname'} eq $env{'user.name'}) &&
                                       ($item->{'udom'} eq $env{'user.domain'})) {
                                       return 'ok';
                                   }
                               }
                           }
                       } 
                 }                  }
             }              }
             my %roleshash;              my %roleshash;
Line 7740  sub get_dns { Line 7692  sub get_dns {
     $domain{$name} = \%this_domain;      $domain{$name} = \%this_domain;
  }   }
     }      }
       
       sub reset_domain_info {
    undef($loaded);
    undef(%domain);
       }
   
     sub load_domain_tab {      sub load_domain_tab {
  &get_dns('/adm/dns/domain',\&parse_domain_tab);   &get_dns('/adm/dns/domain',\&parse_domain_tab);
  my $fh;   my $fh;
Line 7788  sub get_dns { Line 7745  sub get_dns {
     }      }
  }   }
     }      }
       
       sub reset_hosts_info {
    &reset_domain_info();
    &reset_hosts_ip_info();
    undef(%hostname);
    undef(%hostdom);
    undef(%libserv);
    undef($loaded);
       }
   
     sub load_hosts_tab {      sub load_hosts_tab {
  &get_dns('/adm/dns/hosts',\&parse_hosts_tab);   &get_dns('/adm/dns/hosts',\&parse_hosts_tab);
Line 7874  sub get_dns { Line 7840  sub get_dns {
  }   }
  return;   return;
     }      }
       
       sub reset_hosts_ip_info {
    undef(%iphost);
    undef(%name_to_ip);
    undef(%lonid_to_ip);
       }
   
     sub get_host_ip {      sub get_host_ip {
  my ($lonid) = @_;   my ($lonid) = @_;
Line 7893  sub get_dns { Line 7865  sub get_dns {
  if (%iphost) { return %iphost; }   if (%iphost) { return %iphost; }
  my %hostname = &all_hostnames();   my %hostname = &all_hostnames();
  foreach my $id (keys(%hostname)) {   foreach my $id (keys(%hostname)) {
     my $name=$hostname{$id};      my $name=&hostname($id);
     my $ip;      my $ip;
     if (!exists($name_to_ip{$name})) {      if (!exists($name_to_ip{$name})) {
  $ip = gethostbyname($name);   $ip = gethostbyname($name);

Removed from v.1.862  
changed lines
  Added in v.1.865


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