File Coverage

blib/lib/Data/Checker/Ping.pm
Criterion Covered Total %
statement 25 26 96.1
branch 7 8 87.5
condition n/a
subroutine 5 5 100.0
pod 1 1 100.0
total 38 40 95.0


line stmt bran cond sub pod time code
1             package Data::Checker::Ping;
2             # Copyright (c) 2013-2014 Sullivan Beck. All rights reserved.
3             # This program is free software; you can redistribute it and/or modify it
4             # under the same terms as Perl itself.
5              
6             ###############################################################################
7              
8             require 5.008;
9 1     1   4 use warnings 'all';
  1         1  
  1         57  
10 1     1   6 use strict;
  1         2  
  1         39  
11 1     1   709 use Net::Ping;
  1         11393  
  1         71  
12 1     1   10 use Net::Ping::External;
  1         1  
  1         215  
13              
14             our($VERSION);
15             $VERSION='1.05';
16              
17             ###############################################################################
18             ###############################################################################
19              
20             sub check {
21 2     2 1 3 my($obj,$element,$desc,$check_opts) = @_;
22 2         4 my $err = [];
23 2         2 my $warn = [];
24 2         3 my $info = [];
25              
26 2 50       6 if (! defined $check_opts) {
27 0         0 $check_opts = { 'tcp' => undef };
28             }
29              
30             # Do the pings
31              
32 2         5 foreach my $proto (qw(tcp udp icmp stream syn external)) {
33 12 100       26 next if (! $obj->check_performed($check_opts,$proto));
34              
35 2         13 my $ping = Net::Ping->new($proto);
36 2         151 my $timeout = $obj->check_option($check_opts,'timeout',5,$proto);
37 2 100       10 my $up = ($ping->ping($element,$timeout) ? 1 : 0);
38              
39 2         226654 $obj->check_value($check_opts,$proto,$element,$up,
40             "Host does not respond to $proto pings",
41             "Host does respond to $proto pings",
42             $err,$warn,$info);
43 2 100       47 return ($element,$err,$warn,$info) if (@$err);
44             }
45              
46 1         47 return ($element,$err,$warn,$info);
47             }
48              
49             1;
50             # Local Variables:
51             # mode: cperl
52             # indent-tabs-mode: nil
53             # cperl-indent-level: 3
54             # cperl-continued-statement-offset: 2
55             # cperl-continued-brace-offset: 0
56             # cperl-brace-offset: 0
57             # cperl-brace-imaginary-offset: 0
58             # cperl-label-offset: 0
59             # End: