File Coverage

blib/lib/Egg/Plugin/Net/Ping.pm
Criterion Covered Total %
statement 12 33 36.3
branch 0 12 0.0
condition 0 15 0.0
subroutine 4 6 66.6
pod 1 1 100.0
total 17 67 25.3


line stmt bran cond sub pod time code
1             package Egg::Plugin::Net::Ping;
2             #
3             # Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
4             #
5             # $Id: Ping.pm 271 2008-02-24 06:52:22Z lushe $
6             #
7 2     2   546 use strict;
  2         5  
  2         76  
8 2     2   10 use warnings;
  2         3  
  2         65  
9 2     2   2547 use Net::Ping;
  2         115277  
  2         153  
10 2     2   24 use Carp qw/croak/;
  2         4  
  2         584  
11              
12             our $VERSION= '3.01';
13              
14             sub _setup {
15 0     0     my($e)= @_;
16 0   0       my $conf= $e->config->{plugin_net_ping} ||= {};
17 0   0       $conf->{protcol} ||= 'tcp';
18 0   0       $conf->{timeout} ||= 3;
19 0   0       $conf->{retry} ||= 1;
20 0   0       $conf->{wait} ||= 0.5;
21 0           $e->next::method;
22             }
23             sub ping {
24 0     0 1   my $e= shift;
25 0   0       my $host= shift || croak q{ I want target host. };
26 0           my %option= (
27 0 0 0       %{$e->config->{plugin_net_ping}},
28 0           %{ $_[1] ? {@_}: ($_[0] || {}) },
29             );
30 0 0         $option{retry}= 5 if $option{retry}> 5;
31              
32 0           my $ping= Net::Ping->new($option{protcol});
33 0 0         $ping->bind($option{self_addr}) if $option{self_addr};
34              
35 0           my($result, $count);
36 0           for (1..$option{retry}) {
37 0 0         ++$result if $ping->ping($host, $option{timeout});
38 0 0         ++$count>= $option{retry} and last;
39 0           select(undef, undef, undef, $option{wait}); ## no critic
40             }
41              
42 0 0         $result || 0;
43             }
44              
45             1;
46              
47             __END__
48              
49             =head1 NAME
50              
51             Egg::Plugin::Net::Ping - Net::Ping for Egg plugin.
52              
53             =head1 SYNOPSIS
54              
55             use Egg qw/ Net::Ping /;
56            
57             __PACKAGE__->egg_startup(
58             ...
59             .....
60             plugin_net_ping => {
61             protcol => 'tcp',
62             timeout => 3,
63             retry => 1,
64             wait => 0.5,
65             },
66             );
67              
68             if ( $e->ping('192.168.1.1') ) {
69             print " Ping was answered. !! ";
70             } else {
71             print " There is no answer to Ping. ";
72             }
73              
74             =head1 DESCRIPTION
75              
76             It is a plug-in to investigate while arbitrary PC is operating by L<Net::Ping>.
77              
78             =head1 CONFIGURATION
79              
80             Please set 'plugin_net_ping'.
81              
82             =head3 protcol
83              
84             They are the protocols such as tcp and udp.
85              
86             Default is 'tcp'.
87              
88             * I do not think that it operates well perhaps excluding tcp.
89              
90             =head3 timeout
91              
92             Time to wait for answer of ping.
93              
94             Default is '3'.
95              
96             =head3 retry
97              
98             Frequency in which ping is done.
99              
100             =head3 wait
101              
102             Waiting time to doing next retry.
103              
104             Default is '0.5'.
105              
106             =head3 self_addr
107              
108             Own host address.
109              
110             =head1 METHODS
111              
112             =head2 ping ( [TARGET_HOST], [ARGS_HASH] )
113              
114             Ping is sent to TARGET_HOST, and the succeeding frequency is returned.
115              
116             ARGS_HASH overwrites initialization.
117              
118             * When retry is set to five times or more, five is compulsorily set.
119              
120             $e->ping('192.168.1.111', retry => 5 );
121              
122             =head1 SEE ALSO
123              
124             L<Egg::Release>,
125             L<Net::Ping>,
126              
127             =head1 AUTHOR
128              
129             Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
130              
131             =head1 COPYRIGHT AND LICENSE
132              
133             Copyright (C) 2008 Bee Flag, Corp. E<lt>L<http://egg.bomcity.com/>E<gt>, All Rights Reserved.
134              
135             This library is free software; you can redistribute it and/or modify
136             it under the same terms as Perl itself, either Perl version 5.8.6 or,
137             at your option, any later version of Perl 5 you may have available.
138              
139             =cut
140