File Coverage

blib/lib/Net/Prober/tcp.pm
Criterion Covered Total %
statement 29 34 85.2
branch 3 8 37.5
condition 2 8 25.0
subroutine 6 6 100.0
pod 0 1 0.0
total 40 57 70.1


line stmt bran cond sub pod time code
1             package Net::Prober::tcp;
2             $Net::Prober::tcp::VERSION = '0.17';
3 1     1   6 use strict;
  1         2  
  1         22  
4 1     1   4 use warnings;
  1         2  
  1         20  
5 1     1   4 use base 'Net::Prober::Probe::TCP';
  1         2  
  1         328  
6              
7 1     1   9 use Carp ();
  1         3  
  1         21  
8 1     1   6 use Net::Prober ();
  1         2  
  1         151  
9              
10             sub probe {
11 2     2 0 5 my ($self, $args) = @_;
12              
13 2         8 my ($host, $port, $timeout, $proto) =
14             $self->parse_args($args, qw(host port timeout proto));
15              
16 2         8 $port = Net::Prober::port_name_to_num($port);
17              
18 2 50 33     12 if (! defined $port or $port == 0) {
19 0         0 Carp::croak("Can't probe: undefined port");
20             }
21              
22 2   50     4 $timeout ||= 3.5;
23              
24 2         9 my $t0 = $self->time_now();
25              
26 2         8 my $sock = $self->open_socket($args);
27 2         1360 my $good = 0;
28 2         4 my $reason;
29              
30 2 50       5 if (! $sock) {
31 2         4 $reason = "Socket open failed";
32             }
33             else {
34 0   0     0 $good = $sock->connected() && $sock->close();
35 0 0       0 if (! $good) {
36 0         0 $reason = "Socket connect or close failed";
37             }
38             }
39              
40 2         10 my $elapsed = $self->time_elapsed();
41              
42 2 50       5 if ($good) {
43 0         0 return $self->probe_ok(
44             time => $elapsed,
45             host => $host,
46             port => $port,
47             );
48             }
49              
50 2         10 return $self->probe_failed(
51             time => $elapsed,
52             host => $host,
53             port => $port,
54             reason => $reason,
55             );
56              
57             }
58              
59             1;
60              
61             __END__