ffaaa1b03b04f5a8d1ddf1f32eb24a9d137a3f02
1 package Net::Oping;
3 =head1 NAME
5 Net::Oping - ICMP latency measurement module using the oping library.
7 =head1 SYNOPSIS
9 use Net::Oping;
11 my $obj = Net::Oping->new ();
12 $obj->host_add (qw(one.example.org two.example.org));
14 my $ret = $obj->ping ();
15 print "Latency to `one' is " . $ret->{'one.example.org'} . "\n";
17 =head1 DESCRIPTION
19 This Perl module is a high-level interface to the
20 L<oping library|http://verplant.org/liboping/>. Its purpose it to send C<ICMP
21 ECHO_REQUEST> packets (also known as "ping") to a host and measure the time
22 that elapses until the reception of an C<ICMP ECHO_REPLY> packet (also known as
23 "pong"). If no such packet is received after a certain timeout the host is considered to be unreachable.
25 The used C<oping> library supports "ping"ing multiple hosts in parallel and
26 works with IPv4 and IPv6 transparently. Other advanced features that are
27 provided by the underlying library, such as setting the data sent or
28 configuring the time of live (TTL) are not yet supported by this interface.
30 =cut
32 use strict;
33 use warnings;
35 use Carp (qw(cluck confess));
37 our $VERSION = '1.00';
39 require XSLoader;
40 XSLoader::load ('Net::Oping', $VERSION);
41 return (1);
43 =head1 INTERFACE
45 The interface is kept simple and clean. First you need to create an object to
46 which you then add hosts. Using the C<ping> method you can request a latency
47 measurement and get the current values returned. If neccessary you can remove
48 hosts from the object, too.
50 The constructor and methods are defined as follows:
52 =over 4
54 =item my I<$obj> = Net::Oping-E<gt>B<new> ();
56 Creates and returns a new object.
58 =cut
60 sub new
61 {
62 my $pkg = shift;
63 my $ping_obj = _ping_construct ();
65 my $obj = bless ({ c_obj => $ping_obj }, $pkg);
66 return ($obj);
67 }
69 sub DESTROY
70 {
71 my $obj = shift;
72 _ping_destroy ($obj->{'c_obj'});
73 }
75 =item my I<$status> = I<$obj>-E<gt>B<timeout> (I<$timeout>);
77 Sets the timeout before a host is considered unreachable to I<$timeout>
78 seconds, which may be a floating point number to specify fractional seconds.
80 =cut
82 sub timeout
83 {
84 my $obj = shift;
85 my $timeout = shift;
86 my $status;
88 $status = _ping_setopt_timeout ($obj->{'c_obj'}, $timeout);
89 if ($status != 0)
90 {
91 $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
92 return;
93 }
95 return (1);
96 }
98 =item my I<$status> = I<$obj>-E<gt>B<bind> (I<$ip_addr>);
100 Sets the source IP-address to use. I<$ip_addr> must be a string containing an
101 IP-address, such as "192.168.0.1" or "2001:f00::1". As a side-effect this will
102 set the address-family (IPv4 or IPv6) to a fixed, value, too, for obvious
103 reasons.
105 =cut
107 sub bind
108 {
109 my $obj = shift;
110 my $addr = shift;
111 my $status;
113 $status = _ping_setopt_source ($obj->{'c_obj'}, $addr);
114 if ($status != 0)
115 {
116 $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
117 return;
118 }
120 return (1);
121 }
123 =item my I<$status> = I<$obj>-E<gt>B<host_add> (I<$host>, [I<$host>, ...]);
125 Adds one or more hosts to the Net::Oping-object I<$obj>. The number of
126 successfully added hosts is returned. If this number differs from the number of
127 hosts that were passed to the method you can use B<get_error> (see below) to
128 get the error message of the last failure.
130 =cut
132 sub host_add
133 {
134 my $obj = shift;
135 my $i;
137 $i = 0;
138 for (@_)
139 {
140 my $status = _ping_host_add ($obj->{'c_obj'}, $_);
141 if ($status != 0)
142 {
143 $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
144 }
145 else
146 {
147 $i++;
148 }
149 }
151 return ($i);
152 }
154 =item my I<$status> = I<$obj>-E<gt>B<host_remove> (I<$host>, [I<$host>, ...]);
156 Same semantic as B<host_add> but removes hosts.
158 =cut
160 sub host_remove
161 {
162 my $obj = shift;
163 my $i;
165 $i = 0;
166 for (@_)
167 {
168 my $status = _ping_host_remove ($obj->{'c_obj'}, $_);
169 if ($status != 0)
170 {
171 $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
172 }
173 else
174 {
175 $i++;
176 }
177 }
178 return ($i);
179 }
181 =item my I<$latency> = I<$obj>-E<gt>B<ping> ()
183 The central method of this module sends ICMP packets to the hosts and waits for
184 replies. The time it takes for replies to arrive is measured and returned.
186 The returned scalar is a hash reference where each host associated with the
187 I<$obj> object is a key and the associated value is the corresponding latency
188 in milliseconds. An example hash reference would be:
190 $latency = { host1 => 51.143, host2 => undef, host3 => 54.697, ... };
192 If a value is C<undef>, as for "host2" in this example, the host has timed out
193 and considered unreachable.
195 =cut
197 sub ping
198 {
199 my $obj = shift;
200 my $iter;
201 my $data = {};
202 my $status;
204 $status = _ping_send ($obj->{'c_obj'});
205 if ($status < 0)
206 {
207 print "\$status = $status;\n";
208 $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
209 return;
210 }
212 $iter = _ping_iterator_get ($obj->{'c_obj'});
213 while ($iter)
214 {
215 my $host = _ping_iterator_get_hostname ($iter);
216 if (!$host)
217 {
218 $iter = _ping_iterator_next ($iter);
219 next;
220 }
222 my $latency = _ping_iterator_get_latency ($iter);
223 if ($latency < 0.0)
224 {
225 $latency = undef;
226 }
228 $data->{$host} = $latency;
230 $iter = _ping_iterator_next ($iter);
231 }
233 return ($data);
234 }
236 =item my I<$errmsg> = I<$obj>-E<gt>B<get_error> ();
238 Returns the last error that occured.
240 =cut
242 sub get_error
243 {
244 my $obj = shift;
245 return ($obj->{'err_msg'} || 'Success');
246 }
248 =back
250 =head1 SEE ALSO
252 L<liboping(3)>
254 The C<liboping> homepage may be found at L<http://verplant.org/liboping/>.
255 Information about its mailing list may be found at
256 L<http://mailman.verplant.org/listinfo/liboping>.
258 =head1 AUTHOR
260 First XSE<nbsp>port by Olivier Fredj, extended XS functionality and high-level
261 Perl interface by Florian Forster.
263 =head1 COPYRIGHT AND LICENSE
265 Copyright (C) 2007 by Olivier Fredj E<lt>ofredjE<nbsp>atE<nbsp>proxad.netE<gt>
267 Copyright (C) 2008 by Florian Forster
268 E<lt>octoE<nbsp>atE<nbsp>verplant.orgE<gt>
270 This library is free software; you can redistribute it and/or modify
271 it under the same terms as Perl itself, either Perl version 5.8.7 or,
272 at your option, any later version of Perl 5 you may have available.
274 =cut
276 # vim: set shiftwidth=2 softtabstop=2 tabstop=8 :