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.16';
3 1     1   3 use strict;
  1         1  
  1         26  
4 1     1   4 use warnings;
  1         1  
  1         30  
5 1     1   3 use base 'Net::Prober::Probe::TCP';
  1         1  
  1         472  
6              
7 1     1   5 use Carp ();
  1         1  
  1         11  
8 1     1   3 use Net::Prober ();
  1         1  
  1         150  
9              
10             sub probe {
11 2     2 0 3 my ($self, $args) = @_;
12              
13 2         7 my ($host, $port, $timeout, $proto) =
14             $self->parse_args($args, qw(host port timeout proto));
15              
16 2         6 $port = Net::Prober::port_name_to_num($port);
17              
18 2 50 33     10 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         7 my $t0 = $self->time_now();
25              
26 2         7 my $sock = $self->open_socket($args);
27 2         1454 my $good = 0;
28 2         2 my $reason;
29              
30 2 50       4 if (! $sock) {
31 2         2 $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         11 my $elapsed = $self->time_elapsed();
41              
42 2 50       4 if ($good) {
43 0         0 return $self->probe_ok(
44             time => $elapsed,
45             host => $host,
46             port => $port,
47             );
48             }
49              
50 2         9 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__