view release on metacpan or  search on metacpan

t/50resolver.t  view on Meta::CPAN

#!/usr/bin/perl

use v5.14;
use warnings;

use IO::Async::Test;

use Test2::V0;
use Test::Metrics::Any;

use Socket 1.93 qw( 
   AF_INET SOCK_STREAM SOCK_DGRAM SOCK_RAW INADDR_LOOPBACK INADDR_ANY
   AI_NUMERICHOST AI_PASSIVE NI_NUMERICHOST NI_NUMERICSERV
   pack_sockaddr_in unpack_sockaddr_in sockaddr_family inet_aton inet_ntoa
);

use IO::Async::Loop;

my $loop = IO::Async::Loop->new_builtin;

testing_loop( $loop );

my $resolver = $loop->resolver;
isa_ok( $resolver, [ "IO::Async::Resolver" ], '$loop->resolver isa IO::Async::Resolver' );

SKIP: {
   my @pwuid;
   defined eval { @pwuid = getpwuid( $< ) } or
      skip "No getpwuid()", 5;

   {
      my $future = $resolver->resolve(
         type => 'getpwuid',
         data => [ $< ], 
      );

      isa_ok( $future, [ "Future" ], '$future isa Future' );

      wait_for { $future->is_ready };

      my @result = $future->get;

      is( \@result, \@pwuid, 'getpwuid from future' );
   }

   {
      my $result;

      $resolver->resolve(
         type => 'getpwuid',
         data => [ $< ], 
         on_resolved => sub { $result = [ @_ ] },
         on_error => sub { die "Test died early" },
      );

      wait_for { $result };

      is( $result, \@pwuid, 'getpwuid' );
   }

   {
      my $result;

      $loop->resolve(
         type => 'getpwuid',
         data => [ $< ],
         on_resolved => sub { $result = [ @_ ] },
         on_error => sub { die "Test died early" },
      );

      wait_for { $result };

      is( $result, \@pwuid, 'getpwuid via $loop->resolve' );
   }

   SKIP: {
      my $user_name = $pwuid[0];
      skip "getpwnam - No user name", 1 unless defined $user_name;

      my @pwnam = getpwnam( $user_name );

      my $result;

      $resolver->resolve(
         type => 'getpwnam',
         data => [ $user_name ],
         on_resolved => sub { $result = [ @_ ] },
         on_error => sub { die "Test died early" },
      );

      wait_for { $result };

      is( $result, \@pwnam, 'getpwnam' );
   }
}

my @proto = getprotobyname( "tcp" );

SKIP: {
   skip "getprotobyname - No protocol", 1 unless @proto;
   my $result;

   $resolver->resolve(
      type => 'getprotobyname',
      data => [ "tcp" ],
      on_resolved => sub { $result = [ @_ ] },
      on_error => sub { die "Test died early" },
   );

   wait_for { $result };

   is( $result, \@proto, 'getprotobyname' );
}

SKIP: {
   my $proto_number = $proto[2];
   skip "getprotobynumber - No protocol number", 1 unless defined $proto_number;

   my @proto = getprotobynumber( $proto_number );

   my $result;

   $resolver->resolve(
      type => 'getprotobynumber',
      data => [ $proto_number ],
      on_resolved => sub { $result = [ @_ ] },
      on_error => sub { die "Test died early" },
   );

   wait_for { $result };

   is( $result, \@proto, 'getprotobynumber' );
}

t/50resolver.t  view on Meta::CPAN

   is( \@got, [ "localhost", "www" ], '$resolver->getnameinfo - resolved names from future' );
}

{
   my $result;

   $resolver->getnameinfo(
      addr    => $sinaddr_lo_www,
      numeric => 1,
      on_resolved => sub { $result = [ 'resolved', @_ ] },
      on_error    => sub { $result = [ 'error',    @_ ] },
   );

   is( $result, [ resolved => "127.0.0.1", 80 ], '$resolver->getnameinfo with numeric is synchronous' );
}

{
   my $future = $resolver->getnameinfo(
      addr    => $sinaddr_lo_www,
      numeric => 1,
   );

   is( [ $future->get ], [ "127.0.0.1", 80 ], '$resolver->getnameinfo with numeric is synchronous for future' );
}

# Metrics
SKIP: {
   skip "Metrics are unavailable" unless $IO::Async::Metrics::METRICS;

   is_metrics_from(
      sub {
         $resolver->getnameinfo( addr => $sinaddr_lo_www )->get;
      },
      { "io_async_resolver_lookups type:getnameinfo" => 1 },
      'Resolver increments metrics'
   );

   # Can't easily unit-test the failure counter because we can't guarantee to
   # create a failure
}

# $loop->set_resolver
{
   my $callcount = 0;
   {
      package MockResolver;
      use base qw( IO::Async::Notifier );

      sub new { bless {}, shift }

      sub resolve {
         $callcount++; return Future->done();
      }
      sub getaddrinfo {}
      sub getnameinfo {}
   }

   $loop->set_resolver( MockResolver->new );

   $loop->resolve( type => "getpwuid", data => [ 0 ] )->get;

   is( $callcount, 1, '$callcount 1 after ->resolve' );
}

done_testing;