bindings/perl: Added an improved version of the Perl bindings created by Olivier...

diff --git a/bindings/perl/Changes b/bindings/perl/Changes
new file mode 100644 (file)
index 0000000..974a189
--- /dev/null
+++ b/bindings/perl/Changes
@@ -0,0 +1,9 @@
+Revision history for Perl extension Net::Oping.
+
+1.00  Sat Jan 26 13:52:11 2008
+       - The module has been renamed from `Oping' to `Net::Oping'.
+       - The XS code has been simplyfied and a high-level interface has been
+         created in Perl.
+
+0.01  Wed Oct 24 01:32:19 2007
+       - original version; created by h2xs 1.23.

diff --git a/bindings/perl/MANIFEST b/bindings/perl/MANIFEST
new file mode 100644 (file)
index 0000000..1c39f9b
--- /dev/null
+++ b/bindings/perl/MANIFEST
@@ -0,0 +1,10 @@
+Changes
+Makefile.PL
+MANIFEST
+Oping.xs
+ppport.h
+README
+t/Oping.t
+typemap
+lib/Net/Oping.pm
+META.yml                                 Module meta-data (added by MakeMaker)

diff --git a/bindings/perl/META.yml b/bindings/perl/META.yml
new file mode 100644 (file)
index 0000000..2aede20
--- /dev/null
+++ b/bindings/perl/META.yml
@@ -0,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
+name:         Net-Oping
+version:      1.00
+version_from: lib/Net/Oping.pm
+installdirs:  site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.30_01

diff --git a/bindings/perl/Makefile.PL b/bindings/perl/Makefile.PL
new file mode 100644 (file)
index 0000000..4e375a5
--- /dev/null
+++ b/bindings/perl/Makefile.PL
@@ -0,0 +1,15 @@
+use 5.008007;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME              => 'Net::Oping',
+    VERSION_FROM      => 'lib/Net/Oping.pm',
+    PREREQ_PM         => {},
+    ($] >= 5.005
+     ? (ABSTRACT_FROM => 'lib/Net/Oping.pm',
+        AUTHOR        => 'Florian Forster <octo@verplant.org>')
+     : ()),
+    LIBS              => ['-loping', '-L/opt/oping/lib/ -loping'],
+    DEFINE            => '',
+    INC               => '-I/opt/oping/include/'
+);

diff --git a/bindings/perl/Oping.xs b/bindings/perl/Oping.xs
new file mode 100644 (file)
index 0000000..0cebf3d
--- /dev/null
+++ b/bindings/perl/Oping.xs
@@ -0,0 +1,149 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <errno.h>
+#include <assert.h>
+#include <netdb.h> /* NI_MAXHOST */
+#include <oping.h>
+
+MODULE = Net::Oping            PACKAGE = Net::Oping            
+
+PROTOTYPES: DISABLE
+
+pingobj_t *
+_ping_construct ()
+       CODE:
+               RETVAL = ping_construct ();
+       OUTPUT:
+               RETVAL
+
+void 
+_ping_destroy (obj);
+       pingobj_t *obj
+       CODE:
+               ping_destroy(obj);
+
+int
+_ping_setopt_timeout (obj, timeout)
+       pingobj_t *obj
+       double timeout
+       CODE:
+               RETVAL = ping_setopt (obj, PING_OPT_TIMEOUT, &timeout);
+       OUTPUT:
+               RETVAL
+
+int
+_ping_setopt_source (obj, addr)
+       pingobj_t *obj
+       char *addr
+       CODE:
+               RETVAL = ping_setopt (obj, PING_OPT_SOURCE, addr);
+       OUTPUT:
+               RETVAL
+
+int 
+_ping_host_add (obj, host);
+       pingobj_t *obj
+       const char *host
+       CODE:
+               RETVAL = ping_host_add (obj, host);
+       OUTPUT:
+               RETVAL
+
+int 
+_ping_host_remove (obj, host)
+       pingobj_t *obj
+       const char *host
+       CODE:
+               RETVAL = ping_host_remove (obj, host);
+       OUTPUT:
+               RETVAL
+
+int 
+_ping_send (obj)
+       pingobj_t *obj
+       CODE:
+               RETVAL=ping_send (obj);
+       OUTPUT:
+               RETVAL
+
+pingobj_iter_t *
+_ping_iterator_get (obj)
+       pingobj_t *obj
+       CODE:
+               RETVAL = ping_iterator_get (obj);
+       OUTPUT:
+               RETVAL
+
+pingobj_iter_t *
+_ping_iterator_next (iter)
+       pingobj_iter_t *iter
+       CODE:
+               RETVAL = ping_iterator_next (iter);
+       OUTPUT:
+               RETVAL
+
+double
+_ping_iterator_get_latency (iter)
+       pingobj_iter_t *iter
+       CODE:
+               double tmp;
+               size_t tmp_size;
+               int status;
+
+               RETVAL = -1.0;
+
+               tmp_size = sizeof (tmp);
+               status = ping_iterator_get_info (iter, PING_INFO_LATENCY,
+                       (void *) &tmp, &tmp_size);
+               if (status == 0)
+                       RETVAL = tmp;
+       OUTPUT:
+               RETVAL
+
+char *
+_ping_iterator_get_hostname (iter)
+       pingobj_iter_t *iter
+       CODE:
+               char *buffer;
+               size_t buffer_size;
+               int status;
+
+               RETVAL = NULL;
+
+       do {
+               buffer = NULL;
+               buffer_size = 0;
+               status = ping_iterator_get_info (iter, PING_INFO_HOSTNAME,
+                               (void *) buffer, &buffer_size);
+               if (status != ENOMEM)
+                       break;
+
+               /* FIXME: This is a workaround for a bug in 0.3.5. */
+               buffer_size++;
+
+               buffer = (char *) malloc (buffer_size);
+               if (buffer == NULL)
+                       break;
+
+               status = ping_iterator_get_info (iter, PING_INFO_HOSTNAME,
+                               (void *) buffer, &buffer_size);
+               if (status != 0)
+                       break;
+
+               RETVAL = buffer;
+       } while (0);
+       OUTPUT:
+               RETVAL
+
+const char *
+_ping_get_error (obj)
+       pingobj_t *obj
+       CODE:
+               RETVAL = ping_get_error(obj);
+       OUTPUT:
+               RETVAL

diff --git a/bindings/perl/README b/bindings/perl/README
new file mode 100644 (file)
index 0000000..d0af548
--- /dev/null
+++ b/bindings/perl/README
@@ -0,0 +1,41 @@
+Net::Oping version 1.00
+=======================
+
+  ICMP latency measurement module using the oping library.
+
+DESCRIPTION
+
+  This Perl module is a high-level interface to the oping library. Its purpose
+  it to send "ICMP ECHO_REQUEST" packets (also known as "ping") to a host and
+  measure the time that elapses until the reception of an "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 "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.
+
+INSTALLATION
+
+  This module is compiled and installed in the standard Perl way:
+
+    perl Makefile.PL
+    make
+    make test
+    make install
+
+DEPENDENCIES
+
+  This module requires the "oping" library to be installed. The library is
+  available at <http://verplant.org/liboping/>.
+
+COPYRIGHT AND LICENSE
+
+  Copyright (C) 2007 by Olivier Fredj <ofredj at proxad.net>
+
+  Copyright (C) 2008 by Florian Forster <octo at verplant.org>
+
+  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, at your
+  option, any later version of Perl 5 you may have available.

diff --git a/bindings/perl/lib/Net/Oping.pm b/bindings/perl/lib/Net/Oping.pm
new file mode 100644 (file)
index 0000000..d33c578
--- /dev/null
+++ b/bindings/perl/lib/Net/Oping.pm
@@ -0,0 +1,278 @@
+package Net::Oping;
+
+=head1 NAME
+
+Net::Oping - ICMP latency measurement module using the oping library.
+
+=head1 SYNOPSIS
+
+  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";
+
+=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.
+
+The used C<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.
+
+=cut
+
+use 5.008007;
+
+use strict;
+use warnings;
+
+use Carp (qw(cluck confess));
+
+our $VERSION = '1.00';
+
+require XSLoader;
+XSLoader::load('Net::Oping', $VERSION);
+return (1);
+
+=head1 INTERFACE
+
+The interface is kept simple and clean. First you need to create an object to
+which you then add hosts. Using the C<ping> method you can request a latency
+measurement and get the current values returned. If neccessary you can remove
+hosts from the object, too.
+
+The constructor and methods are defined as follows:
+
+=over 4
+
+=item my I<$obj> = Net::Oping-E<gt>B<new> ();
+
+Creates and returns a new object.
+
+=cut
+
+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'});
+}
+
+=item my 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.
+
+=cut
+
+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);
+}
+
+=item my 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
+reasons.
+
+=cut
+
+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);
+}
+
+=item my 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
+hosts that were passed to the method you can use B<get_error> (see below) to
+get the error message of the last failure.
+
+=cut
+
+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);
+}
+
+=item my I<$status> = I<$obj>-E<gt>B<host_remove> (I<$host>, [I<$host>, ...]);
+
+Same semantic as B<host_add> but removes hosts.
+
+=cut
+
+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);
+}
+
+=item my 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 returned scalar is a hash reference where each host associated with the
+I<$obj> object is a key and the associated value is the corresponding latency
+in milliseconds. An example hash reference would be:
+
+  $latency = { host1 => 51.143, host2 => undef, host3 => 54.697, ... };
+
+If a value is C<undef>, as for "host2" in this example, the host has timed out
+and considered unreachable.
+
+=cut
+
+sub ping
+{
+  my $obj = shift;
+  my $iter;
+  my $data = {};
+  my $status;
+
+  $status = _ping_send ($obj->{'c_obj'});
+  if ($status < 0)
+  {
+    print "\$status = $status;\n";
+    $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
+    return;
+  }
+
+  $iter = _ping_iterator_get ($obj->{'c_obj'});
+  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);
+}
+
+=item my I<$errmsg> = I<$obj>-E<gt>B<get_error> ();
+
+Returns the last error that occured.
+
+=cut
+
+sub get_error
+{
+  my $obj = shift;
+  return ($obj->{'err_msg'} || 'Success');
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<liboping(3)>
+
+The C<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>.
+
+=head1 AUTHOR
+
+First XSE<nbsp>port by Olivier Fredj, extended XS functionality and high-level
+Perl interface by Florian Forster.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2007 by Olivier Fredj E<lt>ofredjE<nbsp>atE<nbsp>proxad.netE<gt>
+
+Copyright (C) 2008 by Florian Forster
+E<lt>octoE<nbsp>atE<nbsp>verplant.orgE<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,
+at your option, any later version of Perl 5 you may have available.
+
+=cut
+
+# vim: set shiftwidth=2 softtabstop=2 tabstop=8 :

diff --git a/bindings/perl/t/Oping.t b/bindings/perl/t/Oping.t
new file mode 100644 (file)
index 0000000..63ecfc5
--- /dev/null
+++ b/bindings/perl/t/Oping.t
@@ -0,0 +1,17 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl Oping.t'
+
+#########################
+
+# change 'tests => 2' to 'tests => last_test_to_print';
+
+use Test::More tests => 2;
+BEGIN { use_ok('Net::Oping') };
+
+my $obj = Net::Oping->new ();
+ok (defined ($obj), 'Constructor');
+#########################
+
+# Insert your test code below, the Test::More module is use()ed here so read
+# its man page ( perldoc Test::More ) for help writing this test script.
+

diff --git a/bindings/perl/typemap b/bindings/perl/typemap
new file mode 100644 (file)
index 0000000..3d90144
--- /dev/null
+++ b/bindings/perl/typemap
@@ -0,0 +1,3 @@
+TYPEMAP
+pingobj_t *            T_PTROBJ
+pingobj_iter_t *       T_PTROBJ