=head1 SYNOPSIS
- use Net::Oping;
+ use Net::Oping ();
my $obj = Net::Oping->new ();
$obj->host_add (qw(one.example.org two.example.org));
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
use Carp (qw(cluck confess));
-our $VERSION = '1.02';
+our $VERSION = '1.20';
require XSLoader;
XSLoader::load ('Net::Oping', $VERSION);
=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.
_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.
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
-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
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
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.
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.
}
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.
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.