Net::Oping: Set the $VERSION variable correctly.

[liboping.git] / bindings / perl / lib / Net / Oping.pm

diff --git a/bindings/perl/lib/Net/Oping.pm b/bindings/perl/lib/Net/Oping.pm
index 838fb58..47993dc 100644 (file)
--- a/bindings/perl/lib/Net/Oping.pm
+++ b/bindings/perl/lib/Net/Oping.pm
@@ -30,7 +30,7 @@ Net::Oping - ICMP latency measurement module using the oping library.
 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 

-  use Net::Oping;
+  use Net::Oping ();

 
   my $obj = Net::Oping->new ();
   $obj->host_add (qw(one.example.org two.example.org));
 
   my $obj = Net::Oping->new ();
   $obj->host_add (qw(one.example.org two.example.org));


@@ -49,8 +49,8 @@ host is considered to be unreachable.
 
 The used I<oping> library supports "ping"ing multiple hosts in parallel and
 works with IPv4 and IPv6 transparently. Other advanced features that are
 
 The used I<oping> library supports "ping"ing multiple hosts in parallel and
 works with IPv4 and IPv6 transparently. Other advanced features that are

-provided by the underlying library, such as setting the data sent or
-configuring the time of live (TTL) are not yet supported by this interface.
+provided by the underlying library, such as setting the data sent, are not yet
+supported by this interface.

 
 =cut
 
 
 =cut
 


@@ -61,7 +61,7 @@ use warnings;
 
 use Carp (qw(cluck confess));
 
 
 use Carp (qw(cluck confess));
 

-our $VERSION = '1.02';
+our $VERSION = '1.20';

 
 require XSLoader;
 XSLoader::load ('Net::Oping', $VERSION);
 
 require XSLoader;
 XSLoader::load ('Net::Oping', $VERSION);


@@ -78,7 +78,7 @@ The constructor and methods are defined as follows:
 
 =over 4
 
 
 =over 4
 

-=item my I<$obj> = Net::Oping-E<gt>B<new> ();
+=item I<$obj> = Net::Oping-E<gt>B<new> ();

 
 Creates and returns a new object.
 
 
 Creates and returns a new object.
 


@@ -99,7 +99,7 @@ sub DESTROY
   _ping_destroy ($obj->{'c_obj'});
 }
 
   _ping_destroy ($obj->{'c_obj'});
 }
 

-=item my I<$status> = I<$obj>-E<gt>B<timeout> (I<$timeout>);
+=item I<$status> = I<$obj>-E<gt>B<timeout> (I<$timeout>);

 
 Sets the timeout before a host is considered unreachable to I<$timeout>
 seconds, which may be a floating point number to specify fractional seconds.
 
 Sets the timeout before a host is considered unreachable to I<$timeout>
 seconds, which may be a floating point number to specify fractional seconds.


@@ -122,11 +122,35 @@ sub timeout
   return (1);
 }
 
   return (1);
 }
 

-=item my I<$status> = I<$obj>-E<gt>B<bind> (I<$ip_addr>);
+=item I<$status> = I<$obj>-E<gt>B<ttl> (I<$ttl>);
+
+Sets the I<Time to Live> (TTL) of outgoing packets. I<$ttl> must be in the
+range B<1>E<nbsp>...E<nbsp>B<255>. Returns true when successful and false
+when an error occurred.
+
+=cut
+
+sub ttl
+{
+  my $obj = shift;
+  my $ttl = shift;
+  my $status;
+
+  $status = _ping_setopt_ttl ($obj->{'c_obj'}, $ttl);
+  if ($status != 0)
+  {
+    $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
+    return;
+  }
+
+  return (1);
+}
+
+=item I<$status> = I<$obj>-E<gt>B<bind> (I<$ip_addr>);

 
 Sets the source IP-address to use. I<$ip_addr> must be a string containing an
 IP-address, such as "192.168.0.1" or "2001:f00::1". As a side-effect this will
 
 Sets the source IP-address to use. I<$ip_addr> must be a string containing an
 IP-address, such as "192.168.0.1" or "2001:f00::1". As a side-effect this will

-set the address-family (IPv4 or IPv6) to a fixed, value, too, for obvious
+set the address-family (IPv4 or IPv6) to a fixed value, too, for obvious

 reasons.
 
 =cut
 reasons.
 
 =cut


@@ -147,7 +171,36 @@ sub bind
   return (1);
 }
 
   return (1);
 }
 

-=item my I<$status> = I<$obj>-E<gt>B<host_add> (I<$host>, [I<$host>, ...]);
+=item I<$status> = I<$obj>-E<gt>B<device> (I<$device>);
+
+Sets the network device used for communication. This may not be supported on
+all platforms.
+
+I<Requires liboping 1.3 or later.>
+
+=cut
+
+sub device
+{
+  my $obj = shift;
+  my $device = shift;
+  my $status;
+
+  $status = _ping_setopt_device ($obj->{'c_obj'}, $device);
+  if ($status == -95) # Feature not supported.
+  {
+    $obj->{'err_msg'} = "Feature not supported by your version of liboping.";
+  }
+  elsif ($status != 0)
+  {
+    $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
+    return;
+  }
+
+  return (1);
+}
+
+=item I<$status> = I<$obj>-E<gt>B<host_add> (I<$host>, [I<$host>, ...]);

 
 Adds one or more hosts to the Net::Oping-object I<$obj>. The number of
 successfully added hosts is returned. If this number differs from the number of
 
 Adds one or more hosts to the Net::Oping-object I<$obj>. The number of
 successfully added hosts is returned. If this number differs from the number of


@@ -178,7 +231,7 @@ sub host_add
   return ($i);
 }
 
   return ($i);
 }
 

-=item my I<$status> = I<$obj>-E<gt>B<host_remove> (I<$host>, [I<$host>, ...]);
+=item I<$status> = I<$obj>-E<gt>B<host_remove> (I<$host>, [I<$host>, ...]);

 
 Same semantic as B<host_add> but removes hosts.
 
 
 Same semantic as B<host_add> but removes hosts.
 


@@ -205,7 +258,7 @@ sub host_remove
   return ($i);
 }
 
   return ($i);
 }
 

-=item my I<$latency> = I<$obj>-E<gt>B<ping> ()
+=item I<$latency> = I<$obj>-E<gt>B<ping> ()

 
 The central method of this module sends ICMP packets to the hosts and waits for
 replies. The time it takes for replies to arrive is measured and returned.
 
 The central method of this module sends ICMP packets to the hosts and waits for
 replies. The time it takes for replies to arrive is measured and returned.


@@ -263,9 +316,96 @@ sub ping
   }
 
   return ($data);
   }
 
   return ($data);

-}
+} # ping
+
+=item I<$dropped> = I<$obj>-E<gt>B<get_dropped> ()
+
+Returns a hash reference holding the number of "drops" (echo requests which
+were not answered in time) for each host. An example return
+values would be:
+
+  $droprate = { host1 => 0, host2 => 3, host3 => undef, ... };
+
+Hosts to which no data has been sent yet will return C<undef> ("host3" in thie
+example).
+
+=cut
+
+sub get_dropped
+{
+  my $obj = shift;
+  my $iter;
+  my $data = {};
+
+  $iter = _ping_iterator_get ($obj->{'c_obj'});
+  if (!$iter)
+  {
+    $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
+    return;
+  }
+
+  while ($iter)
+  {
+    my $host = _ping_iterator_get_hostname ($iter);
+    if (!$host)
+    {
+      $iter = _ping_iterator_next ($iter);
+      next;
+    }
+
+    my $dropped = _ping_iterator_get_dropped ($iter);
+    if ($dropped < 0)
+    {
+      $dropped = undef;
+    }
+
+    $data->{$host} = $dropped;
+
+    $iter = _ping_iterator_next ($iter);
+  }
+
+  return ($data);
+} # get_dropped
+
+=item I<$ttl> = I<$obj>-E<gt>B<get_recv_ttl> ()
+
+Returns a hash reference holding the I<Time to Live> (TTL) of the last received
+packet for each host. An example return value would be:
+
+  $ttl = { host1 => 60, host2 => 41, host3 => 243, ... };
+
+To signal an invalid or unavailable TTL, a negative number is returned.
+
+=cut
+
+sub get_recv_ttl
+{
+  my $obj = shift;
+  my $iter;
+  my $data = {};
+
+  $iter = _ping_iterator_get ($obj->{'c_obj'});
+  if (!$iter)
+  {
+    $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
+    return;
+  }
+
+  while ($iter)
+  {
+    my $host = _ping_iterator_get_hostname ($iter);
+    if ($host)
+    {
+      $data->{$host} = _ping_iterator_get_recv_ttl ($iter);
+    }
+
+    $iter = _ping_iterator_next ($iter);
+  }
+
+  return ($data);
+} # get_recv_ttl

 
 

-=item my I<$errmsg> = I<$obj>-E<gt>B<get_error> ();
+=item I<$errmsg> = I<$obj>-E<gt>B<get_error> ();

 
 Returns the last error that occurred.
 
 
 Returns the last error that occurred.
 


@@ -296,7 +436,7 @@ The I<liboping> homepage may be found at L<http://verplant.org/liboping/>.
 Information about its mailing list may be found at
 L<http://mailman.verplant.org/listinfo/liboping>.
 
 Information about its mailing list may be found at
 L<http://mailman.verplant.org/listinfo/liboping>.
 

-=head1 AUTHOR
+=head1 AUTHORS

 
 First XSE<nbsp>port by Olivier Fredj, extended XS functionality and high-level
 Perl interface by Florian Forster.
 
 First XSE<nbsp>port by Olivier Fredj, extended XS functionality and high-level
 Perl interface by Florian Forster.