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 strict;
  33 use warnings;
  34
  35 use Carp (qw(cluck confess));
  36
  37 our $VERSION = '1.00';
  38
  39 require XSLoader;
  40 XSLoader::load ('Net::Oping', $VERSION);
  41 return (1);
  42
  43 =head1 INTERFACE
  44
  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.
  49
  50 The constructor and methods are defined as follows:
  51
  52 =over 4
  53
  54 =item my I<$obj> = Net::Oping-E<gt>B<new> ();
  55
  56 Creates and returns a new object.
  57
  58 =cut
  59
  60 sub new
  61 {
  62   my $pkg = shift;
  63   my $ping_obj = _ping_construct ();
  64
  65   my $obj = bless ({ c_obj => $ping_obj }, $pkg);
  66   return ($obj);
  67 }
  68
  69 sub DESTROY
  70 {
  71   my $obj = shift;
  72   _ping_destroy ($obj->{'c_obj'});
  73 }
  74
  75 =item my I<$status> = I<$obj>-E<gt>B<timeout> (I<$timeout>);
  76
  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.
  79
  80 =cut
  81
  82 sub timeout
  83 {
  84   my $obj = shift;
  85   my $timeout = shift;
  86   my $status;
  87
  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   }
  94
  95   return (1);
  96 }
  97
  98 =item my I<$status> = I<$obj>-E<gt>B<bind> (I<$ip_addr>);
  99
 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.
 104
 105 =cut
 106
 107 sub bind
 108 {
 109   my $obj = shift;
 110   my $addr = shift;
 111   my $status;
 112
 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   }
 119
 120   return (1);
 121 }
 122
 123 =item my I<$status> = I<$obj>-E<gt>B<host_add> (I<$host>, [I<$host>, ...]);
 124
 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.
 129
 130 =cut
 131
 132 sub host_add
 133 {
 134   my $obj = shift;
 135   my $i;
 136
 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   }
 150
 151   return ($i);
 152 }
 153
 154 =item my I<$status> = I<$obj>-E<gt>B<host_remove> (I<$host>, [I<$host>, ...]);
 155
 156 Same semantic as B<host_add> but removes hosts.
 157
 158 =cut
 159
 160 sub host_remove
 161 {
 162   my $obj = shift;
 163   my $i;
 164
 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 }
 180
 181 =item my I<$latency> = I<$obj>-E<gt>B<ping> ()
 182
 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.
 185
 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:
 189
 190   $latency = { host1 => 51.143, host2 => undef, host3 => 54.697, ... };
 191
 192 If a value is C<undef>, as for "host2" in this example, the host has timed out
 193 and considered unreachable.
 194
 195 =cut
 196
 197 sub ping
 198 {
 199   my $obj = shift;
 200   my $iter;
 201   my $data = {};
 202   my $status;
 203
 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   }
 211
 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     }
 221
 222     my $latency = _ping_iterator_get_latency ($iter);
 223     if ($latency < 0.0)
 224     {
 225       $latency = undef;
 226     }
 227
 228     $data->{$host} = $latency;
 229
 230     $iter = _ping_iterator_next ($iter);
 231   }
 232
 233   return ($data);
 234 }
 235
 236 =item my I<$errmsg> = I<$obj>-E<gt>B<get_error> ();
 237
 238 Returns the last error that occured.
 239
 240 =cut
 241
 242 sub get_error
 243 {
 244   my $obj = shift;
 245   return ($obj->{'err_msg'} || 'Success');
 246 }
 247
 248 =back
 249
 250 =head1 SEE ALSO
 251
 252 L<liboping(3)>
 253
 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>.
 257
 258 =head1 AUTHOR
 259
 260 First XSE<nbsp>port by Olivier Fredj, extended XS functionality and high-level
 261 Perl interface by Florian Forster.
 262
 263 =head1 COPYRIGHT AND LICENSE
 264
 265 Copyright (C) 2007 by Olivier Fredj E<lt>ofredjE<nbsp>atE<nbsp>proxad.netE<gt>
 266
 267 Copyright (C) 2008 by Florian Forster
 268 E<lt>octoE<nbsp>atE<nbsp>verplant.orgE<gt>
 269
 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.
 273
 274 =cut
 275
 276 # vim: set shiftwidth=2 softtabstop=2 tabstop=8 :