[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.860 and 1.864

version 1.860, 2007/04/03 18:47:29 version 1.864, 2007/04/04 00:48:23
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'} );  
  }   }
     }      }
       
       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 7796  sub get_dns { Line 7736  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 );  
  }   }
     }      }
       
       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 7809  sub get_dns { Line 7757  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 7888  sub get_dns { Line 7833  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 7907  sub get_dns { Line 7858  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);
Line 7927  sub get_dns { Line 7878  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.864

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