File Coverage

blib/lib/Net/Async/Ping/TCP.pm
Criterion Covered Total %
statement 41 44 93.1
branch 6 12 50.0
condition 3 9 33.3
subroutine 11 12 91.6
pod 1 2 50.0
total 62 79 78.4


line stmt bran cond sub pod time code
1             package Net::Async::Ping::TCP;
2             $Net::Async::Ping::TCP::VERSION = '0.004001';
3 1     1   1683 use Moo;
  1         7870  
  1         5  
4 1     1   1653 use warnings NONFATAL => 'all';
  1         5  
  1         63  
5              
6 1     1   7 use Carp qw/croak/;
  1         1  
  1         76  
7 1     1   649 use Future;
  1         9867  
  1         47  
8 1     1   45 use POSIX 'ECONNREFUSED';
  1         3  
  1         32  
9 1     1   133 use Time::HiRes;
  1         3  
  1         6  
10 1     1   92 use Scalar::Util qw/blessed/;
  1         3  
  1         66  
11              
12             extends 'IO::Async::Notifier';
13              
14 1     1   8 use namespace::clean;
  1         3  
  1         18  
15              
16             has default_timeout => (
17             is => 'ro',
18             default => 5,
19             );
20              
21             has service_check => ( is => 'rw' );
22              
23             has bind => ( is => 'rw' );
24              
25             has port_number => (
26             is => 'rw',
27             default => 7,
28             );
29              
30             # Overrides method in IO::Async::Notifier to allow specific options in this class
31             sub configure_unknown
32 1     1 1 1400 { my $self = shift;
33 1         3 my %params = @_;
34 1         6 delete $params{$_} foreach qw/default_timeout service_check bind/;
35 1 50       6 return unless keys %params;
36 0         0 my $class = ref $self;
37 0         0 croak "Unrecognised configuration keys for $class - " . join( " ", keys %params );
38              
39             }
40              
41             sub ping {
42 1     1 0 241 my $self = shift;
43             # Maintain compat with old API
44 1 50       9 my $legacy = blessed $_[0] and $_[0]->isa('IO::Async::Loop');
45 1 50       7 my $loop = $legacy ? shift : $self->loop;
46              
47 1         7 my ($host, $timeout) = @_;
48 1   33     10 $timeout ||= $self->default_timeout;
49              
50 1         3 my $service_check = $self->service_check;
51              
52 1         5 my $t0 = [Time::HiRes::gettimeofday];
53              
54             return Future->wait_any(
55             $loop->connect(
56             host => $host,
57             service => $self->port_number,
58             socktype => 'stream',
59             ($self->bind ? (
60             local_host => $self->bind,
61             ) : ()),
62             ),
63             $loop->timeout_future(after => $timeout)
64             )
65             ->then(
66 0     0   0 sub { Future->done(Time::HiRes::tv_interval($t0)) },
67             sub {
68 1     1   76058 my ($human, $layer) = @_;
69 1         17 my $ex = pop;
70 1 50 33     48 if ($layer && $layer eq 'connect') {
71 1 50 33     8 return Future->done(Time::HiRes::tv_interval($t0))
72             if !$service_check && $ex == ECONNREFUSED;
73             }
74 1         7 Future->fail(Time::HiRes::tv_interval($t0))
75             },
76             )
77 1 50       18 }
78              
79             1;
80              
81             __END__