[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.845 and 1.848

version 1.845, 2007/03/08 01:54:50 version 1.848, 2007/03/14 23:36:10
Line 35  use HTTP::Headers; Line 35  use HTTP::Headers;
 use HTTP::Date;  use HTTP::Date;
 # use Date::Parse;  # use Date::Parse;
 use vars   use vars 
 qw(%perlvar %badServerCache %iphost %spareid   qw(%perlvar %badServerCache %spareid 
    %pr %prp $memcache %packagetab      %pr %prp $memcache %packagetab 
    %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount      %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount 
    %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %coursetypebuf     %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %coursetypebuf
    %domaindescription %domain_auth_def %domain_auth_arg_def   
    %domain_lang_def %domain_city %domain_longi %domain_lati %domain_primary  
    $tmpdir $_64bit %env);     $tmpdir $_64bit %env);
   
 use IO::Socket;  use IO::Socket;
Line 727  sub get_dom { Line 725  sub get_dom {
     }      }
     $items=~s/\&$//;      $items=~s/\&$//;
     if (!$udom) { $udom=$env{'user.domain'}; }      if (!$udom) { $udom=$env{'user.domain'}; }
     if (exists($domain_primary{$udom})) {      if (defined(&domain($udom,'primary'))) {
         my $uhome=$domain_primary{$udom};          my $uhome=&domain($udom,'primary');
         my $rep=&reply("getdom:$udom:$namespace:$items",$uhome);          my $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
         my @pairs=split(/\&/,$rep);          my @pairs=split(/\&/,$rep);
         if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) {          if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) {
Line 751  sub get_dom { Line 749  sub get_dom {
 sub put_dom {  sub put_dom {
     my ($namespace,$storehash,$udom)=@_;      my ($namespace,$storehash,$udom)=@_;
     if (!$udom) { $udom=$env{'user.domain'}; }      if (!$udom) { $udom=$env{'user.domain'}; }
     if (exists($domain_primary{$udom})) {      if (defined(&domain($udom,'primary'))) {
         my $uhome=$domain_primary{$udom};          my $uhome=&domain($udom,'primary');
         my $items='';          my $items='';
         foreach my $item (keys(%$storehash)) {          foreach my $item (keys(%$storehash)) {
             $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';              $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
Line 767  sub put_dom { Line 765  sub put_dom {
 sub retrieve_inst_usertypes {  sub retrieve_inst_usertypes {
     my ($udom) = @_;      my ($udom) = @_;
     my (%returnhash,@order);      my (%returnhash,@order);
     if (exists($domain_primary{$udom})) {      if (defined(&domain($udom,'primary'))) {
         my $uhome=$domain_primary{$udom};          my $uhome=&domain($udom,'primary');
         my $rep=&reply("inst_usertypes:$udom",$uhome);          my $rep=&reply("inst_usertypes:$udom",$uhome);
         my ($hashitems,$orderitems) = split(/:/,$rep);           my ($hashitems,$orderitems) = split(/:/,$rep); 
         my @pairs=split(/\&/,$hashitems);          my @pairs=split(/\&/,$hashitems);
Line 2170  sub dcmailput { Line 2168  sub dcmailput {
 sub dcmaildump {  sub dcmaildump {
     my ($dom,$startdate,$enddate,$senders) = @_;      my ($dom,$startdate,$enddate,$senders) = @_;
     my %returnhash=();      my %returnhash=();
     if (exists($domain_primary{$dom})) {  
       if (defined(&domain($dom,'primary'))) {
         my $cmd='dcmaildump:'.$dom.':'.&escape($startdate).':'.          my $cmd='dcmaildump:'.$dom.':'.&escape($startdate).':'.
                                                          &escape($enddate).':';                                                           &escape($enddate).':';
  my @esc_senders=map { &escape($_)} @$senders;   my @esc_senders=map { &escape($_)} @$senders;
  $cmd.=&escape(join('&',@esc_senders));   $cmd.=&escape(join('&',@esc_senders));
  foreach my $line (split(/\&/,&reply($cmd,$domain_primary{$dom}))) {   foreach my $line (split(/\&/,&reply($cmd,&domain($dom,'primary')))) {
             my ($key,$value) = split(/\=/,$line,2);              my ($key,$value) = split(/\=/,$line,2);
             if (($key) && ($value)) {              if (($key) && ($value)) {
                 $returnhash{&unescape($key)} = &unescape($value);                  $returnhash{&unescape($key)} = &unescape($value);
Line 6177  sub packages_tab_default { Line 6176  sub packages_tab_default {
     $do_default=1;      $do_default=1;
  } elsif ($pack_type eq 'extension') {   } elsif ($pack_type eq 'extension') {
     push(@extension,[$package,$pack_type,$pack_part]);      push(@extension,[$package,$pack_type,$pack_part]);
  } else {   } elsif ($pack_part eq $part) {
       # only look at packages defaults for packages that this id is
     push(@specifics,[$package,$pack_type,$pack_part]);      push(@specifics,[$package,$pack_type,$pack_part]);
  }   }
     }      }
Line 7567  BEGIN { Line 7567  BEGIN {
   
 # ------------------------------------------------------------ Read domain file  # ------------------------------------------------------------ Read domain file
 {  {
     %domaindescription = ();      my %domain;
     %domain_auth_def = ();  
     %domain_auth_arg_def = ();  
     my $fh;      my $fh;
     if (open($fh,"<".$Apache::lonnet::perlvar{'lonTabDir'}.'/domain.tab')) {      if (open($fh,"<".$Apache::lonnet::perlvar{'lonTabDir'}.'/domain.tab')) {
  while (my $line = <$fh>) {   while (my $line = <$fh>) {
            next if ($line =~ /^(\#|\s*$)/);      next if ($line =~ /^(\#|\s*$ )/);
 #           next if /^\#/;  
            chomp $line;  
            my ($domain, $domain_description, $def_auth, $def_auth_arg,  
        $def_lang, $city, $longi, $lati, $primary) = split(/:/,$line,9);  
    $domain_auth_def{$domain}=$def_auth;  
            $domain_auth_arg_def{$domain}=$def_auth_arg;  
    $domaindescription{$domain}=$domain_description;  
    $domain_lang_def{$domain}=$def_lang;  
    $domain_city{$domain}=$city;  
    $domain_longi{$domain}=$longi;  
    $domain_lati{$domain}=$lati;  
            $domain_primary{$domain}=$primary;  
   
  #         &logthis("Domain.tab: $domain, $domain_auth_def{$domain}, $domain_auth_arg_def{$domain},$domaindescription{$domain}");      chomp($line);
       my ($name,@elements) =  split(/:/,$line,9);
       my %this_domain;
       foreach my $field ('description', 'auth_def', 'auth_arg_def',
          'lang_def', 'city', 'longi', 'lati',
          'primary') {
    $this_domain{$field} = shift(@elements);
       }
       $domain{$name} = \%this_domain;
 #          &logthis("Domain.tab: $domain ".$domaindescription{$domain} );  #          &logthis("Domain.tab: $domain ".$domaindescription{$domain} );
  }   }
     }      }
     close ($fh);      close ($fh);
   
       sub domain {
    my ($name,$what) = @_;
    return if ( !exists($domain{$name}) );
   
    if (!$what) {
       return $domain{$name}{'description'};
    }
    return $domain{$name}{$what};
       }
 }  }
   
   
Line 7667  BEGIN { Line 7672  BEGIN {
     }      }
 }  }
   
 sub get_hosts_from_ip {  { 
     my ($ip) = @_;      my %iphost;
     my %iphosts = &get_iphost();      sub get_hosts_from_ip {
     if (ref($iphosts{$ip})) {   my ($ip) = @_;
  return @{$iphosts{$ip}};   my %iphosts = &get_iphost();
    if (ref($iphosts{$ip})) {
       return @{$iphosts{$ip}};
    }
    return;
     }      }
     return;      
 }      sub get_iphost {
    if (%iphost) { return %iphost; }
 sub get_iphost {   my %name_to_ip;
     if (%iphost) { return %iphost; }   my %hostname = &all_hostnames();
     my %name_to_ip;   foreach my $id (keys(%hostname)) {
     my %hostname = &all_hostnames();      my $name=$hostname{$id};
     foreach my $id (keys(%hostname)) {      my $ip;
  my $name=$hostname{$id};      if (!exists($name_to_ip{$name})) {
  my $ip;   $ip = gethostbyname($name);
  if (!exists($name_to_ip{$name})) {   if (!$ip || length($ip) ne 4) {
     $ip = gethostbyname($name);      &logthis("Skipping host $id name $name no IP found");
     if (!$ip || length($ip) ne 4) {      next;
  &logthis("Skipping host $id name $name no IP found");   }
  next;   $ip=inet_ntoa($ip);
    $name_to_ip{$name} = $ip;
       } else {
    $ip = $name_to_ip{$name};
     }      }
     $ip=inet_ntoa($ip);      push(@{$iphost{$ip}},$id);
     $name_to_ip{$name} = $ip;  
  } else {  
     $ip = $name_to_ip{$name};  
  }   }
  push(@{$iphost{$ip}},$id);   return %iphost;
     }      }
     return %iphost;  
 }  }
   
 # ------------------------------------------------------ Read spare server file  # ------------------------------------------------------ Read spare server file
Removed from v.1.845  
changed lines
  Added in v.1.848

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