![[tokkee]](http://tokkee.org/images/avatar.png){kind=avatar}
index 838fb589fc41e582c9e633390fc0a6532798b89c..ba67f739afffcb606a3cc1594b528fb7b9ef7a8d 100644 (file)
#
# Authors:
# Olivier Fredj <ofredj at proxad.net>
#
# Authors:
# Olivier Fredj <ofredj at proxad.net>
-# Florian octo Forster <octo at verplant.org>
+# Florian octo Forster <ff at octo.it>
#
package Net::Oping;
#
package Net::Oping;
=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));
=head1 DESCRIPTION
This Perl module is a high-level interface to the
=head1 DESCRIPTION
This Perl module is a high-level interface to the
-L<oping library|http://verplant.org/liboping/>. Its purpose it to send
-C<ICMP ECHO_REQUEST> packets (also known as "ping") to a host and measure the
-time that elapses until the reception of an C<ICMP ECHO_REPLY> packet (also
-known as "pong"). If no such packet is received after a certain timeout the
-host is considered to be unreachable.
+L<oping library|http://noping.cc/>. Its purpose it to send C<ICMP ECHO_REQUEST>
+packets (also known as "ping") to a host and measure the time that elapses
+until the reception of an C<ICMP ECHO_REPLY> packet (also known as "pong"). If
+no such packet is received after a certain timeout the 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
use Carp (qw(cluck confess));
use Carp (qw(cluck confess));
-our $VERSION = '1.02';
+our $VERSION = '1.21';
require XSLoader;
XSLoader::load ('Net::Oping', $VERSION);
require XSLoader;
XSLoader::load ('Net::Oping', $VERSION);
=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.
_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.
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
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
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.
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.
}
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.
L<liboping(3)>
L<liboping(3)>
-The I<liboping> homepage may be found at L<http://verplant.org/liboping/>.
+The I<liboping> homepage may be found at L<http://noping.cc/>.
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.
Copyright (C) 2007 by Olivier Fredj E<lt>ofredjE<nbsp>atE<nbsp>proxad.netE<gt>
Copyright (C) 2007 by Olivier Fredj E<lt>ofredjE<nbsp>atE<nbsp>proxad.netE<gt>
-Copyright (C) 2008,2009 by Florian Forster
-E<lt>octoE<nbsp>atE<nbsp>verplant.orgE<gt>
+Copyright (C) 2008,2009 by Florian Forster E<lt>ffE<nbsp>atE<nbsp>octo.itE<gt>
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.7 or,
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.7 or,