Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.860 and 1.863

version 1.860, 2007/04/03 18:47:29 version 1.863, 2007/04/04 00:10:15
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 7704  sub goodbye { Line 7649  sub goodbye {
    &logthis("Shutting down");     &logthis("Shutting down");
 }  }
   
 BEGIN {  
   
 # ----------------------------------- Read loncapa.conf and loncapa_apache.conf  
     unless ($readit) {  
 {  
     my $configvars = LONCAPA::Configuration::read_conf('loncapa.conf');  
     %perlvar = (%perlvar,%{$configvars});  
 }  
   
 sub get_dns {  sub get_dns {
     my ($url,$func) = @_;      my ($url,$func) = @_;
     open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");      open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
Line 7747  sub get_dns { Line 7683  sub get_dns {
  $this_domain{$field} = shift(@elements);   $this_domain{$field} = shift(@elements);
     }      }
     $domain{$name} = \%this_domain;      $domain{$name} = \%this_domain;
     &logthis("Domain.tab: $name ".$domain{$name}{'description'} );  
  }   }
     }      }
           
Line 7796  sub get_dns { Line 7731  sub get_dns {
  $hostdom{$id}=$domain;   $hostdom{$id}=$domain;
  if ($role eq 'library') { $libserv{$id}=$name; }   if ($role eq 'library') { $libserv{$id}=$name; }
     }      }
     &logthis("Hosts.tab: $name ".$id );  
  }   }
     }      }
   
Line 7809  sub get_dns { Line 7743  sub get_dns {
  $loaded=1;   $loaded=1;
     }      }
   
     # FIXME: dev server don't want this, production servers _do_ want this  
     #&get_iphost();  
   
     sub hostname {      sub hostname {
  &load_hosts_tab() if (!$loaded);   &load_hosts_tab() if (!$loaded);
   
Line 7927  sub get_dns { Line 7858  sub get_dns {
     }      }
 }  }
   
   BEGIN {
   
   # ----------------------------------- Read loncapa.conf and loncapa_apache.conf
       unless ($readit) {
   {
       my $configvars = LONCAPA::Configuration::read_conf('loncapa.conf');
       %perlvar = (%perlvar,%{$configvars});
   }
   
   
 # ------------------------------------------------------ Read spare server file  # ------------------------------------------------------ Read spare server file
 {  {
     open(my $config,"<$perlvar{'lonTabDir'}/spare.tab");      open(my $config,"<$perlvar{'lonTabDir'}/spare.tab");

Removed from v.1.860  
changed lines
  Added in v.1.863


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