view release on metacpan or  search on metacpan

lib/Metabrik/Network/Dns.pm  view on Meta::CPAN

         $h->{target} = $rr->target;
      }

      push @res, $h;
   }

   return \@res;
}

sub background_lookup {
   my $self = shift;
   my ($host, $type, $nameserver, $port) = @_;

   $type ||= $self->type;
   $nameserver ||= $self->nameserver;
   $port ||= $self->port;
   $self->brik_help_run_undef_arg('background_lookup', $host) or return;
   $self->brik_help_run_undef_arg('background_lookup', $nameserver) or return;

   my $resolver = $self->resolver;
   if (! defined($resolver)) {
      $self->create_resolver($nameserver, $port) or return;
      $resolver = $self->resolver;
   }

   $self->log->debug("background_lookup: host [$host] for type [$type]");

   my $handle;
   eval {
      $handle = $resolver->bgsend($host, $type);
   };
   if ($@ && $@ !~ m{long domain label}) {
      chomp($@);
      my $ns = ref($nameserver) eq 'ARRAY' ? join('|', @$nameserver)
         : $nameserver;
      return $self->log->error("background_lookup: bgsend exception [$@], ".
         "with nameservers [$ns] and port [$port]");
   }
   elsif (! defined($handle)) {
      my $ns = ref($nameserver) eq 'ARRAY' ? join('|', @$nameserver)
         : $nameserver;
      return $self->log->error("background_lookup: query failed [".
         $resolver->errorstring."], with nameservers [$ns] and ".
         "port [$port]");
   }

   return $handle;
}

sub background_read {
   my $self = shift;
   my ($handle) = @_;

   my $resolver = $self->resolver;
   $self->brik_help_set_undef_arg('resolver', $resolver) or return;
   $self->brik_help_run_undef_arg('background_read', $handle) or return;
   $self->brik_help_run_invalid_arg('background_read', $handle, 'IO::Socket::IP')
      or return;

   # Answer not ready
   if ($resolver->bgbusy($handle)) {
      return 0;
   }

   my $packet;
   eval {
      $packet = $resolver->bgread($handle);
   };
   if ($@) {
      chomp($@);
      return $self->log->error("background_read: bgread exception [$@]");
   }
   elsif (! defined($packet)) {
      return [];  # No error checking possible, undef means no response or timeout.
   }

   $self->log->debug("background_read: ".$packet->string);

   my @res = ();
   my @answers = $packet->answer;
   for my $rr (@answers) {
      $self->log->debug("background_read: ".$rr->string);

      my $h = {
         type => $rr->type,
         ttl => $rr->ttl,
         name => $rr->name,
         string => $rr->string,
         raw => $rr,
      };
      if ($rr->can('address')) {
         $h->{address} = $rr->address;
      }
      if ($rr->can('cname')) {
         $h->{cname} = $rr->cname;
      }
      if ($rr->can('exchange')) {
         $h->{exchange} = $rr->exchange;
      }
      if ($rr->can('nsdname')) {
         $h->{nsdname} = $rr->nsdname;
      }
      if ($rr->can('ptrdname')) {
         $h->{ptrdname} = $rr->ptrdname;
      }
      if ($rr->can('rdatastr')) {
         $h->{rdatastr} = $rr->rdatastr;
      }
      if ($rr->can('dummy')) {
         $h->{dummy} = $rr->dummy;
      }
      if ($rr->can('target')) {
         $h->{target} = $rr->target;
      }

      push @res, $h;
   }

   return \@res;
}