Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1209 and 1.1210

version 1.1209, 2013/01/03 19:58:32 version 1.1210, 2013/02/02 00:22:47
Line 11556  sub goodbye { Line 11556  sub goodbye {
 }  }
   
 sub get_dns {  sub get_dns {
     my ($url,$func,$ignore_cache) = @_;      my ($url,$func,$ignore_cache,$nocache,$hashref) = @_;
     if (!$ignore_cache) {      if (!$ignore_cache) {
  my ($content,$cached)=   my ($content,$cached)=
     &Apache::lonnet::is_cached_new('dns',$url);      &Apache::lonnet::is_cached_new('dns',$url);
  if ($cached) {   if ($cached) {
     &$func($content);      &$func($content,$hashref);
     return;      return;
  }   }
     }      }
Line 11586  sub get_dns { Line 11586  sub get_dns {
         delete($alldns{$dns});          delete($alldns{$dns});
  next if ($response->is_error());   next if ($response->is_error());
  my @content = split("\n",$response->content);   my @content = split("\n",$response->content);
  &Apache::lonnet::do_cache_new('dns',$url,\@content,30*24*60*60);   unless ($nocache) {
  &$func(\@content);      &Apache::lonnet::do_cache_new('dns',$url,\@content,30*24*60*60);
    }
    &$func(\@content,$hashref);
  return;   return;
     }      }
     close($config);      close($config);
Line 11595  sub get_dns { Line 11597  sub get_dns {
     &logthis("unable to contact DNS defaulting to on disk file dns_$which.tab\n");      &logthis("unable to contact DNS defaulting to on disk file dns_$which.tab\n");
     open($config,"<$perlvar{'lonTabDir'}/dns_$which.tab");      open($config,"<$perlvar{'lonTabDir'}/dns_$which.tab");
     my @content = <$config>;      my @content = <$config>;
     &$func(\@content);      &$func(\@content,$hashref);
       return;
   }
   
   # ------------------------------------------------------Get DNS checksums file
   sub write_dns_checksums_tab {
       my ($lines,$hashref) = @_;
       my $machine_dom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});
       my $loncaparev = &get_server_loncaparev($machine_dom);
       my ($release,$timestamp) = split(/\-/,$loncaparev);
       my (%chksum,%revnum);
       if (ref($lines) eq 'ARRAY') {
           chomp(@{$lines});
           my $versions = shift(@{$lines});
           my %supported;
           if ($versions =~ /^VERSIONS\:([\w\.\,]+)$/) {
               my $releaseslist = $1;
               if ($releaseslist =~ /,/) {
                   map { $supported{$_} = 1; } split(/,/,$releaseslist);
               } elsif ($releaseslist) {
                   $supported{$releaseslist} = 1;
               }
           }
           if ($supported{$release}) {  
               my $matchthis = 0;
               foreach my $line (@{$lines}) {
                   if ($line =~ /^(\d[\w\.]+)$/) {
                       if ($matchthis) {
                           last;
                       } elsif ($1 eq $release) {
                           $matchthis = 1;
                       }
                   } elsif ($matchthis) {
                       my ($file,$version,$shasum) = split(/,/,$line);
                       $chksum{$file} = $shasum;
                       $revnum{$file} = $version;
                   }
               }
               if (ref($hashref) eq 'HASH') {
                   %{$hashref} = (
                                   sums     => \%chksum,
                                   versions => \%revnum,
                                 );
               }
           }
       }
     return;      return;
 }  }
   
   sub fetch_dns_checksums {
       my %checksums; 
           &get_dns('/adm/dns/checksums',\&write_dns_checksums_tab,1,1,
                    \%checksums);
       return \%checksums;
   }
   
 # ------------------------------------------------------------ Read domain file  # ------------------------------------------------------------ Read domain file
 {  {
     my $loaded;      my $loaded;

Removed from v.1.1209  
changed lines
  Added in v.1.1210


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