bindings/perl/lib/Net/Oping.pm

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