Net::Oping - ICMP latency measurement module using the oping library.

  use Net::Oping ();

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

  my $ret = $obj->ping ();
  print "Latency to `one' is " . $ret->{'one.example.org'} . "\n";

#
# Net-Oping - lib/Net/Oping.pm
# Copyright (C) 2007       Olivier Fredj
# Copyright (C) 2008,2009  Florian octo Forster
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; only version 2 of the License is
# applicable.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
#
# Authors:
#   Olivier Fredj <ofredj at proxad.net>
#   Florian octo Forster <octo at verplant.org>
#

package Net::Oping;

use 5.006;

use strict;
use warnings;

use Carp (qw(cluck confess));

our $VERSION = '1.21';

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

sub new
{
  my $pkg = shift;
  my $ping_obj = _ping_construct ();

  my $obj = bless ({ c_obj => $ping_obj }, $pkg);
  return ($obj);
}

sub DESTROY
{
  my $obj = shift;
  _ping_destroy ($obj->{'c_obj'});
}

sub timeout
{
  my $obj = shift;
  my $timeout = shift;
  my $status;

  $status = _ping_setopt_timeout ($obj->{'c_obj'}, $timeout);
  if ($status != 0)
  {
    $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
    return;
  }

  return (1);
}

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);
}

sub bind
{
  my $obj = shift;
  my $addr = shift;
  my $status;

  $status = _ping_setopt_source ($obj->{'c_obj'}, $addr);
  if ($status != 0)
  {
    $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
    return;
  }

  return (1);
}

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);
}

sub host_add
{
  my $obj = shift;
  my $i;

  $i = 0;
  for (@_)
  {
    my $status = _ping_host_add ($obj->{'c_obj'}, $_);
    if ($status != 0)
    {
      $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
    }
    else
    {
      $i++;
    }
  }

  return ($i);
}

sub host_remove
{
  my $obj = shift;
  my $i;

  $i = 0;
  for (@_)
  {
    my $status = _ping_host_remove ($obj->{'c_obj'}, $_);
    if ($status != 0)
    {
      $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
    }
    else
    {
      $i++;
    }
  }
  return ($i);
}

sub ping
{
  my $obj = shift;
  my $iter;
  my $data = {};
  my $status;

  $status = _ping_send ($obj->{'c_obj'});
  if ($status < 0)
  {
    $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
    return;
  }

  $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 $latency = _ping_iterator_get_latency ($iter);
    if ($latency < 0.0)
    {
      $latency = undef;
    }

    $data->{$host} = $latency;

    $iter = _ping_iterator_next ($iter);
  }

  return ($data);
} # ping

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

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

sub get_error
{
  my $obj = shift;
  return ($obj->{'err_msg'} || 'Success');
}

# vim: set shiftwidth=2 softtabstop=2 tabstop=8 :