Upgrade to Net::Ping 2.14.
authorJarkko Hietaniemi <jhi@iki.fi>
Tue, 2 Apr 2002 18:35:27 +0000 (18:35 +0000)
committerJarkko Hietaniemi <jhi@iki.fi>
Tue, 2 Apr 2002 18:35:27 +0000 (18:35 +0000)
p4raw-id: //depot/perl@15687

MANIFEST
lib/Net/Ping.pm
lib/Net/Ping/CHANGES
lib/Net/Ping/README
lib/Net/Ping/t/130_tcp_inst.t
lib/Net/Ping/t/140_stream_inst.t
lib/Net/Ping/t/250_ping_hires.t [new file with mode: 0644]

index 355c5ed..8598a84 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1225,6 +1225,7 @@ lib/Net/Ping/t/120_udp_inst.t             Ping Net::Ping
 lib/Net/Ping/t/130_tcp_inst.t          Ping Net::Ping
 lib/Net/Ping/t/140_stream_inst.t       Ping Net::Ping
 lib/Net/Ping/t/200_ping_tcp.t          Ping Net::Ping
+lib/Net/Ping/t/250_ping_hires.t                Ping Net::Ping
 lib/Net/Ping/t/300_ping_stream.t       Ping Net::Ping
 lib/Net/POP3.pm                        libnet
 lib/Net/protoent.pm            By-name interface to Perl's builtin getproto*
index e81c997..874f1c5 100644 (file)
@@ -1,22 +1,22 @@
 package Net::Ping;
 
-# $Id: Ping.pm,v 1.17 2002/02/18 01:25:11 rob Exp $
+# $Id: Ping.pm,v 1.27 2002/04/02 02:01:21 rob Exp $
 
 require 5.002;
 require Exporter;
 
 use strict;
 use vars qw(@ISA @EXPORT $VERSION
-            $def_timeout $def_proto $max_datasize $pingstring);
+            $def_timeout $def_proto $max_datasize $pingstring $hires);
 use FileHandle;
 use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET
-               inet_aton sockaddr_in );
+               inet_aton inet_ntoa sockaddr_in );
 use Carp;
 use Errno qw(ECONNREFUSED);
 
 @ISA = qw(Exporter);
 @EXPORT = qw(pingecho);
-$VERSION = "2.12";
+$VERSION = "2.14";
 
 # Constants
 
@@ -33,13 +33,13 @@ $pingstring = "pingschwingping!\n";
 
 sub pingecho
 {
-    my ($host,              # Name or IP number of host to ping
-        $timeout            # Optional timeout in seconds
-        ) = @_;
-    my ($p);                # A ping object
+  my ($host,              # Name or IP number of host to ping
+      $timeout            # Optional timeout in seconds
+      ) = @_;
+  my ($p);                # A ping object
 
-    $p = Net::Ping->new("tcp", $timeout);
-    $p->ping($host);        # Going out of scope closes the connection
+  $p = Net::Ping->new("tcp", $timeout);
+  $p->ping($host);        # Going out of scope closes the connection
 }
 
 # Description:  The new() method creates a new ping object.  Optional
@@ -51,76 +51,76 @@ sub pingecho
 
 sub new
 {
-    my ($this,
-        $proto,             # Optional protocol to use for pinging
-        $timeout,           # Optional timeout in seconds
-        $data_size          # Optional additional bytes of data
-        ) = @_;
-    my  $class = ref($this) || $this;
-    my  $self = {};
-    my ($cnt,               # Count through data bytes
-        $min_datasize       # Minimum data bytes required
-        );
-
-    bless($self, $class);
-
-    $proto = $def_proto unless $proto;          # Determine the protocol
-    croak('Protocol for ping must be "icmp", "udp", "tcp", "stream", or "external"')
-        unless $proto =~ m/^(icmp|udp|tcp|stream|external)$/;
-    $self->{"proto"} = $proto;
-
-    $timeout = $def_timeout unless $timeout;    # Determine the timeout
-    croak("Default timeout for ping must be greater than 0 seconds")
-        if $timeout <= 0;
-    $self->{"timeout"} = $timeout;
-
-    $min_datasize = ($proto eq "udp") ? 1 : 0;  # Determine data size
-    $data_size = $min_datasize unless defined($data_size) && $proto ne "tcp";
-    croak("Data for ping must be from $min_datasize to $max_datasize bytes")
-        if ($data_size < $min_datasize) || ($data_size > $max_datasize);
-    $data_size-- if $self->{"proto"} eq "udp";  # We provide the first byte
-    $self->{"data_size"} = $data_size;
-
-    $self->{"data"} = "";                       # Construct data bytes
-    for ($cnt = 0; $cnt < $self->{"data_size"}; $cnt++)
-    {
-        $self->{"data"} .= chr($cnt % 256);
-    }
-
-    $self->{"local_addr"} = undef;              # Don't bind by default
-
-    $self->{"seq"} = 0;                         # For counting packets
-    if ($self->{"proto"} eq "udp")              # Open a socket
-    {
-        $self->{"proto_num"} = (getprotobyname('udp'))[2] ||
-            croak("Can't udp protocol by name");
-        $self->{"port_num"} = (getservbyname('echo', 'udp'))[2] ||
-            croak("Can't get udp echo port by name");
-        $self->{"fh"} = FileHandle->new();
-        socket($self->{"fh"}, PF_INET, SOCK_DGRAM,
-               $self->{"proto_num"}) ||
-            croak("udp socket error - $!");
-    }
-    elsif ($self->{"proto"} eq "icmp")
-    {
-        croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS');
-        $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
-                    croak("Can't get icmp protocol by name");
-        $self->{"pid"} = $$ & 0xffff;           # Save lower 16 bits of pid
-        $self->{"fh"} = FileHandle->new();
-        socket($self->{"fh"}, PF_INET, SOCK_RAW, $self->{"proto_num"}) ||
-            croak("icmp socket error - $!");
-    }
-    elsif ($self->{"proto"} eq "tcp" || $self->{"proto"} eq "stream")
-    {
-        $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
-            croak("Can't get tcp protocol by name");
-        $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
-            croak("Can't get tcp echo port by name");
-        $self->{"fh"} = FileHandle->new();
-    }
-
-    return($self);
+  my ($this,
+      $proto,             # Optional protocol to use for pinging
+      $timeout,           # Optional timeout in seconds
+      $data_size          # Optional additional bytes of data
+      ) = @_;
+  my  $class = ref($this) || $this;
+  my  $self = {};
+  my ($cnt,               # Count through data bytes
+      $min_datasize       # Minimum data bytes required
+      );
+
+  bless($self, $class);
+
+  $proto = $def_proto unless $proto;          # Determine the protocol
+  croak('Protocol for ping must be "icmp", "udp", "tcp", "stream", or "external"')
+    unless $proto =~ m/^(icmp|udp|tcp|stream|external)$/;
+  $self->{"proto"} = $proto;
+
+  $timeout = $def_timeout unless $timeout;    # Determine the timeout
+  croak("Default timeout for ping must be greater than 0 seconds")
+    if $timeout <= 0;
+  $self->{"timeout"} = $timeout;
+
+  $min_datasize = ($proto eq "udp") ? 1 : 0;  # Determine data size
+  $data_size = $min_datasize unless defined($data_size) && $proto ne "tcp";
+  croak("Data for ping must be from $min_datasize to $max_datasize bytes")
+    if ($data_size < $min_datasize) || ($data_size > $max_datasize);
+  $data_size-- if $self->{"proto"} eq "udp";  # We provide the first byte
+  $self->{"data_size"} = $data_size;
+
+  $self->{"data"} = "";                       # Construct data bytes
+  for ($cnt = 0; $cnt < $self->{"data_size"}; $cnt++)
+  {
+    $self->{"data"} .= chr($cnt % 256);
+  }
+
+  $self->{"local_addr"} = undef;              # Don't bind by default
+
+  $self->{"seq"} = 0;                         # For counting packets
+  if ($self->{"proto"} eq "udp")              # Open a socket
+  {
+    $self->{"proto_num"} = (getprotobyname('udp'))[2] ||
+      croak("Can't udp protocol by name");
+    $self->{"port_num"} = (getservbyname('echo', 'udp'))[2] ||
+      croak("Can't get udp echo port by name");
+    $self->{"fh"} = FileHandle->new();
+    socket($self->{"fh"}, PF_INET, SOCK_DGRAM,
+           $self->{"proto_num"}) ||
+             croak("udp socket error - $!");
+  }
+  elsif ($self->{"proto"} eq "icmp")
+  {
+    croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS');
+    $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
+      croak("Can't get icmp protocol by name");
+    $self->{"pid"} = $$ & 0xffff;           # Save lower 16 bits of pid
+    $self->{"fh"} = FileHandle->new();
+    socket($self->{"fh"}, PF_INET, SOCK_RAW, $self->{"proto_num"}) ||
+      croak("icmp socket error - $!");
+  }
+  elsif ($self->{"proto"} eq "tcp" || $self->{"proto"} eq "stream")
+  {
+    $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
+      croak("Can't get tcp protocol by name");
+    $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
+      croak("Can't get tcp echo port by name");
+    $self->{"fh"} = FileHandle->new();
+  }
+
+  return($self);
 }
 
 # Description: Set the local IP address from which pings will be sent.
@@ -129,33 +129,50 @@ sub new
 # opened.  Returns non-zero if successful; croaks on error.
 sub bind
 {
-    my ($self,
-        $local_addr         # Name or IP number of local interface
-        ) = @_;
-    my ($ip                 # Packed IP number of $local_addr
-        );
-
-    croak("Usage: \$p->bind(\$local_addr)") unless @_ == 2;
-    croak("already bound") if defined($self->{"local_addr"}) &&
-            ($self->{"proto"} eq "udp" || $self->{"proto"} eq "icmp");
+  my ($self,
+      $local_addr         # Name or IP number of local interface
+      ) = @_;
+  my ($ip                 # Packed IP number of $local_addr
+      );
+
+  croak("Usage: \$p->bind(\$local_addr)") unless @_ == 2;
+  croak("already bound") if defined($self->{"local_addr"}) &&
+    ($self->{"proto"} eq "udp" || $self->{"proto"} eq "icmp");
+
+  $ip = inet_aton($local_addr);
+  croak("nonexistent local address $local_addr") unless defined($ip);
+  $self->{"local_addr"} = $ip; # Only used if proto is tcp
+
+  if ($self->{"proto"} eq "udp" || $self->{"proto"} eq "icmp")
+  {
+  CORE::bind($self->{"fh"}, sockaddr_in(0, $ip)) ||
+    croak("$self->{'proto'} bind error - $!");
+  }
+  elsif ($self->{"proto"} ne "tcp")
+  {
+    croak("Unknown protocol \"$self->{proto}\" in bind()");
+  }
+
+  return 1;
+}
 
-    $ip = inet_aton($local_addr);
-    croak("nonexistent local address $local_addr") unless defined($ip);
-    $self->{"local_addr"} = $ip; # Only used if proto is tcp
 
-    if ($self->{"proto"} eq "udp" || $self->{"proto"} eq "icmp")
-    {
-        CORE::bind($self->{"fh"}, sockaddr_in(0, $ip)) ||
-                croak("$self->{'proto'} bind error - $!");
-    }
-    elsif ($self->{"proto"} ne "tcp")
-    {
-        croak("Unknown protocol \"$self->{proto}\" in bind()");
-    }
+# Description: allows the module to use milliseconds as returned by
+# the Time::HiRes module
 
-    return 1;
+$hires = 0;
+sub hires
+{
+  my $self = shift;
+  $hires = 1 unless defined
+    ($hires = ((defined $self) && (ref $self)) ? shift() : $self);
+  require Time::HiRes if $hires;
 }
 
+sub time
+{
+  return $hires ? Time::HiRes::time() : CORE::time();
+}
 
 # Description: Ping a host name or IP number with an optional timeout.
 # First lookup the host, and return undef if it is not found.  Otherwise
@@ -164,29 +181,43 @@ sub bind
 
 sub ping
 {
-    my ($self,
-        $host,              # Name or IP number of host to ping
-        $timeout            # Seconds after which ping times out
-        ) = @_;
-    my ($ip,                # Packed IP number of $host
-        $ret                # The return value
-        );
-
-    croak("Usage: \$p->ping(\$host [, \$timeout])") unless @_ == 2 || @_ == 3;
-    $timeout = $self->{"timeout"} unless $timeout;
-    croak("Timeout must be greater than 0 seconds") if $timeout <= 0;
-
-    $ip = inet_aton($host);
-    return(undef) unless defined($ip);      # Does host exist?
-
-    # Dispatch to the appropriate routine.
-    return $self->ping_external($ip, $timeout) if $self->{"proto"} eq "external";
-    return $self->ping_udp($ip, $timeout)      if $self->{"proto"} eq "udp";
-    return $self->ping_icmp($ip, $timeout)     if $self->{"proto"} eq "icmp";
-    return $self->ping_tcp($ip, $timeout)      if $self->{"proto"} eq "tcp";
-    return $self->ping_stream($ip, $timeout)   if $self->{"proto"} eq "stream";
-
+  my ($self,
+      $host,              # Name or IP number of host to ping
+      $timeout,           # Seconds after which ping times out
+      ) = @_;
+  my ($ip,                # Packed IP number of $host
+      $ret,               # The return value
+      $ping_time,         # When ping began
+      );
+
+  croak("Usage: \$p->ping(\$host [, \$timeout])") unless @_ == 2 || @_ == 3;
+  $timeout = $self->{"timeout"} unless $timeout;
+  croak("Timeout must be greater than 0 seconds") if $timeout <= 0;
+
+  $ip = inet_aton($host);
+  return(undef) unless defined($ip);      # Does host exist?
+
+  # Dispatch to the appropriate routine.
+  $ping_time = &time();
+  if ($self->{"proto"} eq "external") {
+    $ret = $self->ping_external($ip, $timeout);
+  }
+  elsif ($self->{"proto"} eq "udp") {
+    $ret = $self->ping_udp($ip, $timeout);
+  }
+  elsif ($self->{"proto"} eq "icmp") {
+    $ret = $self->ping_icmp($ip, $timeout);
+  }
+  elsif ($self->{"proto"} eq "tcp") {
+    $ret = $self->ping_tcp($ip, $timeout);
+  }
+  elsif ($self->{"proto"} eq "stream") {
+    $ret = $self->ping_stream($ip, $timeout);
+  } else {
     croak("Unknown protocol \"$self->{proto}\" in ping()");
+  }
+
+  return wantarray ? ($ret, &time() - $ping_time, inet_ntoa($ip)) : $ret;
 }
 
 # Uses Net::Ping::External to do an external ping.
@@ -210,82 +241,82 @@ use constant ICMP_PORT      => 0; # No port with ICMP
 
 sub ping_icmp
 {
-    my ($self,
-        $ip,                # Packed IP number of the host
-        $timeout            # Seconds after which ping times out
-        ) = @_;
-
-    my ($saddr,             # sockaddr_in with port and ip
-        $checksum,          # Checksum of ICMP packet
-        $msg,               # ICMP packet to send
-        $len_msg,           # Length of $msg
-        $rbits,             # Read bits, filehandles for reading
-        $nfound,            # Number of ready filehandles found
-        $finish_time,       # Time ping should be finished
-        $done,              # set to 1 when we are done
-        $ret,               # Return value
-        $recv_msg,          # Received message including IP header
-        $from_saddr,        # sockaddr_in of sender
-        $from_port,         # Port packet was sent from
-        $from_ip,           # Packed IP of sender
-        $from_type,         # ICMP type
-        $from_subcode,      # ICMP subcode
-        $from_chk,          # ICMP packet checksum
-        $from_pid,          # ICMP packet id
-        $from_seq,          # ICMP packet sequence
-        $from_msg           # ICMP message
-        );
-
-    $self->{"seq"} = ($self->{"seq"} + 1) % 65536; # Increment sequence
-    $checksum = 0;                          # No checksum for starters
-    $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMP_ECHO, SUBCODE,
-                $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
-    $checksum = Net::Ping->checksum($msg);
-    $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMP_ECHO, SUBCODE,
-                $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
-    $len_msg = length($msg);
-    $saddr = sockaddr_in(ICMP_PORT, $ip);
-    send($self->{"fh"}, $msg, ICMP_FLAGS, $saddr); # Send the message
-
-    $rbits = "";
-    vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
-    $ret = 0;
-    $done = 0;
-    $finish_time = time() + $timeout;       # Must be done by this time
-    while (!$done && $timeout > 0)          # Keep trying if we have time
+  my ($self,
+      $ip,                # Packed IP number of the host
+      $timeout            # Seconds after which ping times out
+      ) = @_;
+
+  my ($saddr,             # sockaddr_in with port and ip
+      $checksum,          # Checksum of ICMP packet
+      $msg,               # ICMP packet to send
+      $len_msg,           # Length of $msg
+      $rbits,             # Read bits, filehandles for reading
+      $nfound,            # Number of ready filehandles found
+      $finish_time,       # Time ping should be finished
+      $done,              # set to 1 when we are done
+      $ret,               # Return value
+      $recv_msg,          # Received message including IP header
+      $from_saddr,        # sockaddr_in of sender
+      $from_port,         # Port packet was sent from
+      $from_ip,           # Packed IP of sender
+      $from_type,         # ICMP type
+      $from_subcode,      # ICMP subcode
+      $from_chk,          # ICMP packet checksum
+      $from_pid,          # ICMP packet id
+      $from_seq,          # ICMP packet sequence
+      $from_msg           # ICMP message
+      );
+
+  $self->{"seq"} = ($self->{"seq"} + 1) % 65536; # Increment sequence
+  $checksum = 0;                          # No checksum for starters
+  $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMP_ECHO, SUBCODE,
+              $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
+  $checksum = Net::Ping->checksum($msg);
+  $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMP_ECHO, SUBCODE,
+              $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
+  $len_msg = length($msg);
+  $saddr = sockaddr_in(ICMP_PORT, $ip);
+  send($self->{"fh"}, $msg, ICMP_FLAGS, $saddr); # Send the message
+
+  $rbits = "";
+  vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
+  $ret = 0;
+  $done = 0;
+  $finish_time = &time() + $timeout;      # Must be done by this time
+  while (!$done && $timeout > 0)          # Keep trying if we have time
+  {
+    $nfound = select($rbits, undef, undef, $timeout); # Wait for packet
+    $timeout = $finish_time - &time();    # Get remaining time
+    if (!defined($nfound))                # Hmm, a strange error
     {
-        $nfound = select($rbits, undef, undef, $timeout); # Wait for packet
-        $timeout = $finish_time - time();   # Get remaining time
-        if (!defined($nfound))              # Hmm, a strange error
-        {
-            $ret = undef;
-            $done = 1;
-        }
-        elsif ($nfound)                     # Got a packet from somewhere
-        {
-            $recv_msg = "";
-            $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, ICMP_FLAGS);
-            ($from_port, $from_ip) = sockaddr_in($from_saddr);
-            ($from_type, $from_subcode, $from_chk,
-             $from_pid, $from_seq, $from_msg) =
-                unpack(ICMP_STRUCT . $self->{"data_size"},
-                       substr($recv_msg, length($recv_msg) - $len_msg,
-                              $len_msg));
-            if (($from_type == ICMP_ECHOREPLY) &&
-                ($from_ip eq $ip) &&
-                ($from_pid == $self->{"pid"}) && # Does the packet check out?
-                ($from_seq == $self->{"seq"}))
-            {
-                $ret = 1;                   # It's a winner
-                $done = 1;
-            }
-        }
-        else                                # Oops, timed out
-        {
-            $done = 1;
-        }
+      $ret = undef;
+      $done = 1;
+    }
+    elsif ($nfound)                     # Got a packet from somewhere
+    {
+      $recv_msg = "";
+      $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, ICMP_FLAGS);
+      ($from_port, $from_ip) = sockaddr_in($from_saddr);
+      ($from_type, $from_subcode, $from_chk,
+       $from_pid, $from_seq, $from_msg) =
+         unpack(ICMP_STRUCT . $self->{"data_size"},
+                substr($recv_msg, length($recv_msg) - $len_msg,
+                       $len_msg));
+      if (($from_type == ICMP_ECHOREPLY) &&
+          ($from_ip eq $ip) &&
+          ($from_pid == $self->{"pid"}) && # Does the packet check out?
+          ($from_seq == $self->{"seq"}))
+      {
+        $ret = 1;                   # It's a winner
+        $done = 1;
+      }
     }
-    return($ret)
+    else                                # Oops, timed out
+    {
+      $done = 1;
+    }
+  }
+  return $ret;
 }
 
 # Description:  Do a checksum on the message.  Basically sum all of
@@ -293,25 +324,25 @@ sub ping_icmp
 
 sub checksum
 {
-    my ($class,
-        $msg            # The message to checksum
-        ) = @_;
-    my ($len_msg,       # Length of the message
-        $num_short,     # The number of short words in the message
-        $short,         # One short word
-        $chk            # The checksum
-        );
-
-    $len_msg = length($msg);
-    $num_short = int($len_msg / 2);
-    $chk = 0;
-    foreach $short (unpack("S$num_short", $msg))
-    {
-        $chk += $short;
-    }                                           # Add the odd byte in
-    $chk += (unpack("C", substr($msg, $len_msg - 1, 1)) << 8) if $len_msg % 2;
-    $chk = ($chk >> 16) + ($chk & 0xffff);      # Fold high into low
-    return(~(($chk >> 16) + $chk) & 0xffff);    # Again and complement
+  my ($class,
+      $msg            # The message to checksum
+      ) = @_;
+  my ($len_msg,       # Length of the message
+      $num_short,     # The number of short words in the message
+      $short,         # One short word
+      $chk            # The checksum
+      );
+
+  $len_msg = length($msg);
+  $num_short = int($len_msg / 2);
+  $chk = 0;
+  foreach $short (unpack("S$num_short", $msg))
+  {
+    $chk += $short;
+  }                                           # Add the odd byte in
+  $chk += (unpack("C", substr($msg, $len_msg - 1, 1)) << 8) if $len_msg % 2;
+  $chk = ($chk >> 16) + ($chk & 0xffff);      # Fold high into low
+  return(~(($chk >> 16) + $chk) & 0xffff);    # Again and complement
 }
 
 
@@ -327,175 +358,175 @@ sub checksum
 
 sub ping_tcp
 {
-    my ($self,
-        $ip,                # Packed IP number of the host
-        $timeout            # Seconds after which ping times out
-        ) = @_;
-    my ($ret                # The return value
-        );
-
-    $@ = ""; $! = 0;
-    $ret = $self -> tcp_connect( $ip, $timeout);
-    $ret = 1 if $! == ECONNREFUSED  # Connection refused
-      || $@ =~ /Unknown Error/i;    # Special Win32 response?
-    $self->{"fh"}->close();
-    return($ret);
+  my ($self,
+      $ip,                # Packed IP number of the host
+      $timeout            # Seconds after which ping times out
+      ) = @_;
+  my ($ret                # The return value
+      );
+
+  $@ = ""; $! = 0;
+  $ret = $self -> tcp_connect( $ip, $timeout);
+  $ret = 1 if $! == ECONNREFUSED  # Connection refused
+    || $@ =~ /Unknown Error/i;    # Special Win32 response?
+  $self->{"fh"}->close();
+  return $ret;
 }
 
 sub tcp_connect
 {
-    my ($self,
-        $ip,                # Packed IP number of the host
-        $timeout            # Seconds after which connect times out
-        ) = @_;
-    my ($saddr);            # Packed IP and Port
-
-    $saddr = sockaddr_in($self->{"port_num"}, $ip);
-
-    my $ret = 0;            # Default to unreachable
-
-    my $do_socket = sub {
-      socket($self->{"fh"}, PF_INET, SOCK_STREAM, $self->{"proto_num"}) ||
-        croak("tcp socket error - $!");
-      if (defined $self->{"local_addr"} &&
-          !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
-        croak("tcp bind error - $!");
-      }
-    };
-    my $do_connect = sub {
-      eval {
-        die $! unless connect($self->{"fh"}, $saddr);
-        $self->{"ip"} = $ip;
-        $ret = 1;
-      };
-      $ret;
-    };
+  my ($self,
+      $ip,                # Packed IP number of the host
+      $timeout            # Seconds after which connect times out
+      ) = @_;
+  my ($saddr);            # Packed IP and Port
 
-    if ($^O =~ /Win32/i) {
+  $saddr = sockaddr_in($self->{"port_num"}, $ip);
 
-      # Buggy Winsock API doesn't allow us to use alarm() calls.
-      # Hence, if our OS is Windows, we need to create a separate
-      # process to do the blocking connect attempt.
+  my $ret = 0;            # Default to unreachable
 
-      $| = 1; # Clear buffer prior to fork to prevent duplicate flushing.
-      my $pid = fork;
-      if (!$pid) {
-        if (!defined $pid) {
-          # Fork did not work
-          warn "Win32 Fork error: $!";
-          return 0;
-        }
-        &{ $do_socket }();
-
-        # Try a slow blocking connect() call
-        # and report the status to the pipe.
-        if ( &{ $do_connect }() ) {
-          $self->{"fh"}->close();
-          # No error
-          exit 0;
-        } else {
-          # Pass the error status to the parent
-          exit $!;
-        }
+  my $do_socket = sub {
+    socket($self->{"fh"}, PF_INET, SOCK_STREAM, $self->{"proto_num"}) ||
+      croak("tcp socket error - $!");
+    if (defined $self->{"local_addr"} &&
+        !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
+      croak("tcp bind error - $!");
+    }
+  };
+  my $do_connect = sub {
+    eval {
+      die $! unless connect($self->{"fh"}, $saddr);
+      $self->{"ip"} = $ip;
+      $ret = 1;
+    };
+    $ret;
+  };
+
+  if ($^O =~ /Win32/i) {
+
+    # Buggy Winsock API doesn't allow us to use alarm() calls.
+    # Hence, if our OS is Windows, we need to create a separate
+    # process to do the blocking connect attempt.
+
+    $| = 1; # Clear buffer prior to fork to prevent duplicate flushing.
+    my $pid = fork;
+    if (!$pid) {
+      if (!defined $pid) {
+        # Fork did not work
+        warn "Win32 Fork error: $!";
+        return 0;
       }
-
       &{ $do_socket }();
 
-      my $patience = time + $timeout;
-
-      require POSIX;
-      my ($child);
-      $? = 0;
-      # Wait up to the timeout
-      # And clean off the zombie
-      do {
-        $child = waitpid($pid, &POSIX::WNOHANG);
-        $! = $? >> 8;
-        $@ = $!;
-        select(undef, undef, undef, 0.1);
-      } while time < $patience && $child != $pid;
-
-      if ($child == $pid) {
-        # Since she finished within the timeout,
-        # it is probably safe for me to try it too
-        &{ $do_connect }();
+      # Try a slow blocking connect() call
+      # and report the status to the pipe.
+      if ( &{ $do_connect }() ) {
+        $self->{"fh"}->close();
+        # No error
+        exit 0;
       } else {
-        # Time must have run out.
-        $@ = "Timed out!";
-        # Put that choking client out of its misery
-        kill "KILL", $pid;
-        # Clean off the zombie
-        waitpid($pid, 0);
-        $ret = 0;
+        # Pass the error status to the parent
+        exit $!;
       }
-    } else { # Win32
-      # Otherwise don't waste the resources to fork
-
-      &{ $do_socket }();
-
-      $SIG{'ALRM'} = sub { die "Timed out!"; };
-      alarm($timeout);        # Interrupt connect() if we have to
+    }
 
+    &{ $do_socket }();
+
+    my $patience = &time() + $timeout;
+
+    require POSIX;
+    my ($child);
+    $? = 0;
+    # Wait up to the timeout
+    # And clean off the zombie
+    do {
+      $child = waitpid($pid, &POSIX::WNOHANG);
+      $! = $? >> 8;
+      $@ = $!;
+      select(undef, undef, undef, 0.1);
+    } while &time() < $patience && $child != $pid;
+
+    if ($child == $pid) {
+      # Since she finished within the timeout,
+      # it is probably safe for me to try it too
       &{ $do_connect }();
-      alarm(0);
+    } else {
+      # Time must have run out.
+      $@ = "Timed out!";
+      # Put that choking client out of its misery
+      kill "KILL", $pid;
+      # Clean off the zombie
+      waitpid($pid, 0);
+      $ret = 0;
     }
+  } else { # Win32
+    # Otherwise don't waste the resources to fork
+
+    &{ $do_socket }();
+
+    $SIG{'ALRM'} = sub { die "Timed out!"; };
+    alarm($timeout);        # Interrupt connect() if we have to
+
+    &{ $do_connect }();
+    alarm(0);
+  }
 
-    return $ret;
+  return $ret;
 }
 
 # This writes the given string to the socket and then reads it
 # back.  It returns 1 on success, 0 on failure.
 sub tcp_echo
 {
-    my $self = shift;
-    my $timeout = shift;
-    my $pingstring = shift;
-
-    my $ret = undef;
-    my $time = time;
-    my $wrstr = $pingstring;
-    my $rdstr = "";
-
-    eval <<'EOM';
-        do {
-                my $rin = "";
-                vec($rin, $self->{"fh"}->fileno(), 1) = 1;
-
-                my $rout = undef;
-                if($wrstr) {
-                        $rout = "";
-                        vec($rout, $self->{"fh"}->fileno(), 1) = 1;
-                }
-
-                if(select($rin, $rout, undef, ($time + $timeout) - time())) {
-
-                        if($rout && vec($rout,$self->{"fh"}->fileno(),1)) {
-                                my $num = syswrite($self->{"fh"}, $wrstr);
-                                if($num) {
-                                        # If it was a partial write, update and try again.
-                                        $wrstr = substr($wrstr,$num);
-                                } else {
-                                        # There was an error.
-                                        $ret = 0;
-                                }
-                        }
-
-                        if(vec($rin,$self->{"fh"}->fileno(),1)) {
-                                my $reply;
-                                if(sysread($self->{"fh"},$reply,length($pingstring)-length($rdstr))) {
-                                        $rdstr .= $reply;
-                                        $ret = 1 if $rdstr eq $pingstring;
-                                } else {
-                                        # There was an error.
-                                        $ret = 0;
-                                }
-                        }
-
-                }
-        } until time() > ($time + $timeout) || defined($ret);
+  my $self = shift;
+  my $timeout = shift;
+  my $pingstring = shift;
+
+  my $ret = undef;
+  my $time = &time();
+  my $wrstr = $pingstring;
+  my $rdstr = "";
+
+  eval <<'EOM';
+    do {
+      my $rin = "";
+      vec($rin, $self->{"fh"}->fileno(), 1) = 1;
+
+      my $rout = undef;
+      if($wrstr) {
+        $rout = "";
+        vec($rout, $self->{"fh"}->fileno(), 1) = 1;
+      }
+
+      if(select($rin, $rout, undef, ($time + $timeout) - &time())) {
+
+        if($rout && vec($rout,$self->{"fh"}->fileno(),1)) {
+          my $num = syswrite($self->{"fh"}, $wrstr);
+          if($num) {
+            # If it was a partial write, update and try again.
+            $wrstr = substr($wrstr,$num);
+          } else {
+            # There was an error.
+            $ret = 0;
+          }
+        }
+
+        if(vec($rin,$self->{"fh"}->fileno(),1)) {
+          my $reply;
+          if(sysread($self->{"fh"},$reply,length($pingstring)-length($rdstr))) {
+            $rdstr .= $reply;
+            $ret = 1 if $rdstr eq $pingstring;
+          } else {
+            # There was an error.
+            $ret = 0;
+          }
+        }
+
+      }
+    } until &time() > ($time + $timeout) || defined($ret);
 EOM
 
-    return $ret;
+  return $ret;
 }
 
 
@@ -507,20 +538,20 @@ EOM
 
 sub ping_stream
 {
-    my ($self,
-        $ip,                # Packed IP number of the host
-        $timeout            # Seconds after which ping times out
-        ) = @_;
-
-    # Open the stream if it's not already open
-    if(!defined $self->{"fh"}->fileno()) {
-        $self->tcp_connect($ip, $timeout) or return 0;
-    }
+  my ($self,
+      $ip,                # Packed IP number of the host
+      $timeout            # Seconds after which ping times out
+      ) = @_;
 
-    croak "tried to switch servers while stream pinging"
-       if $self->{"ip"} ne $ip;
+  # Open the stream if it's not already open
+  if(!defined $self->{"fh"}->fileno()) {
+    $self->tcp_connect($ip, $timeout) or return 0;
+  }
 
-    return $self->tcp_echo($timeout, $pingstring);
+  croak "tried to switch servers while stream pinging"
+    if $self->{"ip"} ne $ip;
+
+  return $self->tcp_echo($timeout, $pingstring);
 }
 
 # Description: opens the stream.  You would do this if you want to
@@ -528,22 +559,22 @@ sub ping_stream
 
 sub open
 {
-    my ($self,
-        $host,              # Host or IP address
-        $timeout            # Seconds after which open times out
-        ) = @_;
-
-    my ($ip);               # Packed IP number of the host
-    $ip = inet_aton($host);
-    $timeout = $self->{"timeout"} unless $timeout;
-
-    if($self->{"proto"} eq "stream") {
-      if(defined($self->{"fh"}->fileno())) {
-        croak("socket is already open");
-      } else {
-        $self->tcp_connect($ip, $timeout);
-      }
+  my ($self,
+      $host,              # Host or IP address
+      $timeout            # Seconds after which open times out
+      ) = @_;
+
+  my ($ip);               # Packed IP number of the host
+  $ip = inet_aton($host);
+  $timeout = $self->{"timeout"} unless $timeout;
+
+  if($self->{"proto"} eq "stream") {
+    if(defined($self->{"fh"}->fileno())) {
+      croak("socket is already open");
+    } else {
+      $self->tcp_connect($ip, $timeout);
     }
+  }
 }
 
 
@@ -558,64 +589,67 @@ use constant UDP_FLAGS => 0; # Nothing special on send or recv
 
 sub ping_udp
 {
-    my ($self,
-        $ip,                # Packed IP number of the host
-        $timeout            # Seconds after which ping times out
-        ) = @_;
-
-    my ($saddr,             # sockaddr_in with port and ip
-        $ret,               # The return value
-        $msg,               # Message to be echoed
-        $finish_time,       # Time ping should be finished
-        $done,              # Set to 1 when we are done pinging
-        $rbits,             # Read bits, filehandles for reading
-        $nfound,            # Number of ready filehandles found
-        $from_saddr,        # sockaddr_in of sender
-        $from_msg,          # Characters echoed by $host
-        $from_port,         # Port message was echoed from
-        $from_ip            # Packed IP number of sender
-        );
-
-    $saddr = sockaddr_in($self->{"port_num"}, $ip);
-    $self->{"seq"} = ($self->{"seq"} + 1) % 256;    # Increment sequence
-    $msg = chr($self->{"seq"}) . $self->{"data"};   # Add data if any
-    send($self->{"fh"}, $msg, UDP_FLAGS, $saddr);   # Send it
-
-    $rbits = "";
-    vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
-    $ret = 0;                   # Default to unreachable
-    $done = 0;
-    $finish_time = time() + $timeout;       # Ping needs to be done by then
-    while (!$done && $timeout > 0)
+  my ($self,
+      $ip,                # Packed IP number of the host
+      $timeout            # Seconds after which ping times out
+      ) = @_;
+
+  my ($saddr,             # sockaddr_in with port and ip
+      $ret,               # The return value
+      $msg,               # Message to be echoed
+      $finish_time,       # Time ping should be finished
+      $ping_time,         # Time ping took to complete
+      $done,              # Set to 1 when we are done pinging
+      $rbits,             # Read bits, filehandles for reading
+      $nfound,            # Number of ready filehandles found
+      $from_saddr,        # sockaddr_in of sender
+      $from_msg,          # Characters echoed by $host
+      $from_port,         # Port message was echoed from
+      $from_ip            # Packed IP number of sender
+      );
+
+  $saddr = sockaddr_in($self->{"port_num"}, $ip);
+  $self->{"seq"} = ($self->{"seq"} + 1) % 256;    # Increment sequence
+  $msg = chr($self->{"seq"}) . $self->{"data"};   # Add data if any
+  send($self->{"fh"}, $msg, UDP_FLAGS, $saddr);   # Send it
+
+  $rbits = "";
+  vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
+  $ret = 0;                   # Default to unreachable
+  $done = 0;
+  $ping_time = $timeout;
+  $finish_time = &time() + $timeout;       # Ping needs to be done by then
+  while (!$done && $timeout > 0)
+  {
+    $nfound = select($rbits, undef, undef, $timeout); # Wait for response
+    $timeout = $finish_time - &time();   # Get remaining time
+
+    if (!defined($nfound))  # Hmm, a strange error
     {
-        $nfound = select($rbits, undef, undef, $timeout); # Wait for response
-        $timeout = $finish_time - time();   # Get remaining time
-
-        if (!defined($nfound))  # Hmm, a strange error
-        {
-            $ret = undef;
-            $done = 1;
-        }
-        elsif ($nfound)         # A packet is waiting
-        {
-            $from_msg = "";
-            $from_saddr = recv($self->{"fh"}, $from_msg, 1500, UDP_FLAGS)
-               or last; # For example an unreachable host will make recv() fail.
-           ($from_port, $from_ip) = sockaddr_in($from_saddr);
-           if (($from_ip eq $ip) &&        # Does the packet check out?
-               ($from_port == $self->{"port_num"}) &&
-               ($from_msg eq $msg))
-           {
-               $ret = 1;       # It's a winner
-               $done = 1;
-           }
-       }
-        else                    # Oops, timed out
-        {
-            $done = 1;
-        }
+      $ret = undef;
+      $done = 1;
     }
-    return($ret);
+    elsif ($nfound)         # A packet is waiting
+    {
+      $from_msg = "";
+      $from_saddr = recv($self->{"fh"}, $from_msg, 1500, UDP_FLAGS)
+        or last; # For example an unreachable host will make recv() fail.
+      ($from_port, $from_ip) = sockaddr_in($from_saddr);
+      if (($from_ip eq $ip) &&        # Does the packet check out?
+          ($from_port == $self->{"port_num"}) &&
+          ($from_msg eq $msg))
+      {
+        $ret = 1;       # It's a winner
+        $done = 1;
+      }
+    }
+    else                    # Oops, timed out
+    {
+      $done = 1;
+    }
+  }
+  $ping_time -= $timeout;
+  return wantarray ? ($ret, $ping_time) : $ret;
 }
 
 # Description:  Close the connection unless we are using the tcp
@@ -623,9 +657,9 @@ sub ping_udp
 
 sub close
 {
-    my ($self) = @_;
+  my ($self) = @_;
 
-    $self->{"fh"}->close() unless $self->{"proto"} eq "tcp";
+  $self->{"fh"}->close() unless $self->{"proto"} eq "tcp";
 }
 
 
@@ -636,7 +670,7 @@ __END__
 
 Net::Ping - check a remote host for reachability
 
-$Id: Ping.pm,v 1.17 2002/02/18 01:25:11 rob Exp $
+$Id: Ping.pm,v 1.27 2002/04/02 02:01:21 rob Exp $
 
 =head1 SYNOPSIS
 
@@ -668,6 +702,14 @@ $Id: Ping.pm,v 1.17 2002/02/18 01:25:11 rob Exp $
     }
     undef($p);
 
+    # High precision syntax (requires Time::HiRes)
+    $p = Net::Ping->new();
+    $p->hires();
+    ($ret, $duration, $ip) = $p->ping($host, 5.5);
+    printf("$host [ip: $ip] is alive (packet return time: %.2f ms)\n", 1000 * $duration)
+      if $ret;
+    $p->close();
+
     # For backward compatibility
     print "$host is alive.\n" if pingecho($host);
 
@@ -734,6 +776,11 @@ default) number of data bytes is 1 if the protocol is "udp" and 0
 otherwise.  The maximum number of data bytes that can be specified is
 1024.
 
+=item $p->hires( { 0 | 1 } );
+
+Causes this module to use Time::HiRes module, allowing milliseconds
+to be returned by subsequent calls to ping().
+
 =item $p->bind($local_addr);
 
 Sets the source address from which pings will be sent.  This must be
@@ -753,21 +800,14 @@ object.
 Ping the remote host and wait for a response.  $host can be either the
 hostname or the IP number of the remote host.  The optional timeout
 must be greater than 0 seconds and defaults to whatever was specified
-when the ping object was created.  If the hostname cannot be found or
-there is a problem with the IP number, undef is returned.  Otherwise,
-1 is returned if the host is reachable and 0 if it is not.  For all
-practical purposes, undef and 0 and can be treated as the same case.
-
-=item $p->open($host);
-
-When you are using the stream protocol, this call pre-opens the
-tcp socket.  It's only necessary to do this if you want to
-provide a different timeout when creating the connection, or
-remove the overhead of establishing the connection from the
-first ping.  If you don't call C<open()>, the connection is
-automatically opened the first time C<ping()> is called.
-This call simply does nothing if you are using any protocol other
-than stream.
+when the ping object was created.  Returns a success flag.  If the
+hostname cannot be found or there is a problem with the IP number, the
+success flag returned will be undef.  Otherwise, the success flag will
+be 1 if the host is reachable and 0 if it is not.  For most practical
+purposes, undef and 0 and can be treated as the same case.  In array
+context, the elapsed time is also returned.  The elapsed time value will
+be a float, as retuned by the Time::HiRes::time() function, if hires()
+has been previously called, otherwise it is returned as an integer.
 
 =item $p->open($host);
 
@@ -836,10 +876,12 @@ kinds of ICMP packets.
 
 =head1 AUTHORS
 
-  Current maintainers:
-    colinm@cpan.org (Colin McMillen)
+  Current maintainer:
     bbb@cpan.org (Rob Brown)
 
+  External protocol:
+    colinm@cpan.org (Colin McMillen)
+
   Stream protocol:
     bronson@trestle.com (Scott Bronson)
 
@@ -852,9 +894,9 @@ kinds of ICMP packets.
 
 =head1 COPYRIGHT
 
-Copyright (c) 2001, Colin McMillen.  All rights reserved.
+Copyright (c) 2002, Rob Brown.  All rights reserved.
 
-Copyright (c) 2001, Rob Brown.  All rights reserved.
+Copyright (c) 2001, Colin McMillen.  All rights reserved.
 
 This program is free software; you may redistribute it and/or
 modify it under the same terms as Perl itself.
index 172692d..4fb091a 100644 (file)
@@ -1,6 +1,17 @@
 CHANGES
 -------
 
+2.14  Apr 01 14:00 2002
+       - Added reverse lookup feature.
+         e@arix.com (Erick Calder)
+
+2.13  Apr 01 14:00 2002
+       - Added ping time measuring feature.
+         e@arix.com (Erick Calder)
+       - Optionally allow for high resolution
+         precision for timeouts and measuring
+         using the Time::HiRes module (Erick).
+
 2.12  Feb 17 19:00 2002
        - More general error determination for
          better cross platform consistency and
index 5e7d055..68a3631 100644 (file)
@@ -1,7 +1,7 @@
 NAME
     Net::Ping - check a remote host for reachability
 
-    $Id: Ping.pm,v 1.17 2002/02/18 01:25:11 rob Exp $
+    $Id: Ping.pm,v 1.27 2002/04/02 02:01:21 rob Exp $
 
 SYNOPSIS
         use Net::Ping;
@@ -32,6 +32,14 @@ SYNOPSIS
         }
         undef($p);
 
+        # High precision syntax (requires Time::HiRes)
+        $p = Net::Ping->new();
+        $p->hires();
+        ($ret, $duration, $ip) = $p->ping($host, 5.5);
+        printf("$host [ip: $ip] is alive (packet return time: %.2f ms)\n", 1000 * $duration)
+          if $ret;
+        $p->close();
+
         # For backward compatibility
         print "$host is alive.\n" if pingecho($host);
 
@@ -94,6 +102,10 @@ DESCRIPTION
         otherwise. The maximum number of data bytes that can be specified is
         1024.
 
+    $p->hires( { 0 | 1 } );
+        Causes this module to use Time::HiRes module, allowing milliseconds
+        to be returned by subsequent calls to ping().
+
     $p->bind($local_addr);
         Sets the source address from which pings will be sent. This must be
         the address of one of the interfaces on the local host. $local_addr
@@ -111,20 +123,15 @@ DESCRIPTION
         Ping the remote host and wait for a response. $host can be either
         the hostname or the IP number of the remote host. The optional
         timeout must be greater than 0 seconds and defaults to whatever was
-        specified when the ping object was created. If the hostname cannot
-        be found or there is a problem with the IP number, undef is
-        returned. Otherwise, 1 is returned if the host is reachable and 0 if
-        it is not. For all practical purposes, undef and 0 and can be
-        treated as the same case.
-
-    $p->open($host);
-        When you are using the stream protocol, this call pre-opens the tcp
-        socket. It's only necessary to do this if you want to provide a
-        different timeout when creating the connection, or remove the
-        overhead of establishing the connection from the first ping. If you
-        don't call `open()', the connection is automatically opened the
-        first time `ping()' is called. This call simply does nothing if you
-        are using any protocol other than stream.
+        specified when the ping object was created. Returns a success flag.
+        If the hostname cannot be found or there is a problem with the IP
+        number, the success flag returned will be undef. Otherwise, the
+        success flag will be 1 if the host is reachable and 0 if it is not.
+        For most practical purposes, undef and 0 and can be treated as the
+        same case. In array context, the elapsed time is also returned. The
+        elapsed time value will be a float, as retuned by the
+        Time::HiRes::time() function, if hires() has been previously called,
+        otherwise it is returned as an integer.
 
     $p->open($host);
         When you are using the stream protocol, this call pre-opens the tcp
@@ -184,10 +191,12 @@ NOTES
     ICMP packets.
 
 AUTHORS
-      Current maintainers:
-        colinm@cpan.org (Colin McMillen)
+      Current maintainer:
         bbb@cpan.org (Rob Brown)
 
+      External protocol:
+        colinm@cpan.org (Colin McMillen)
+
       Stream protocol:
         bronson@trestle.com (Scott Bronson)
 
@@ -199,9 +208,9 @@ AUTHORS
         mose@ns.ccsn.edu (Russell Mosemann)
 
 COPYRIGHT
-    Copyright (c) 2001, Colin McMillen. All rights reserved.
+    Copyright (c) 2002, Rob Brown. All rights reserved.
 
-    Copyright (c) 2001, Rob Brown. All rights reserved.
+    Copyright (c) 2001, Colin McMillen. All rights reserved.
 
     This program is free software; you may redistribute it and/or modify it
     under the same terms as Perl itself.
index 00be5af..e2efb8c 100644 (file)
@@ -5,7 +5,7 @@ BEGIN {
     print "1..0 \# Skip: no Socket\n";
     exit;
   }
-  unless (getservbyname('echo', 'udp')) {
+  unless (getservbyname('echo', 'tcp')) {
     print "1..0 \# Skip: no echo port\n";
     exit;
   }
index 626b2e1..4492332 100644 (file)
@@ -5,7 +5,7 @@ BEGIN {
     print "1..0 \# Skip: no Socket\n";
     exit;
   }
-  unless (getservbyname('echo', 'udp')) {
+  unless (getservbyname('echo', 'tcp')) {
     print "1..0 \# Skip: no echo port\n";
     exit;
   }
diff --git a/lib/Net/Ping/t/250_ping_hires.t b/lib/Net/Ping/t/250_ping_hires.t
new file mode 100644 (file)
index 0000000..52dae1b
--- /dev/null
@@ -0,0 +1,61 @@
+# Test to make sure hires feature works.
+
+BEGIN {
+  if ($ENV{PERL_CORE}) {
+    unless ($ENV{PERL_TEST_Net_Ping}) {
+      print "1..0 # Skip: network dependent test\n";
+        exit;
+    }
+    chdir 't' if -d 't';
+    @INC = qw(../lib);
+  }
+  unless (eval "require Socket") {
+    print "1..0 \# Skip: no Socket\n";
+    exit;
+  }
+  unless (eval "require Time::HiRes") {
+    print "1..0 \# Skip: no Time::HiRes\n";
+    exit;
+  }
+  unless (getservbyname('echo', 'tcp')) {
+    print "1..0 \# Skip: no echo port\n";
+    exit;
+  }
+}
+
+use Test;
+use Net::Ping;
+plan tests => 8;
+
+# Everything loaded fine
+ok 1;
+
+my $p = new Net::Ping "tcp";
+
+# new() worked?
+ok !!$p;
+
+# Default is to not use Time::HiRes
+ok !$Net::Ping::hires;
+
+# Enable hires
+$p -> hires();
+ok $Net::Ping::hires;
+
+# Make sure disable works
+$p -> hires(0);
+ok !$Net::Ping::hires;
+
+# Enable again
+$p -> hires(1);
+ok $Net::Ping::hires;
+
+# Test on the default port
+my ($ret, $duration) = $p -> ping("localhost");
+
+# localhost should always be reachable, right?
+ok $ret;
+
+# It is extremely likely that the duration contains a decimal
+# point if Time::HiRes is functioning properly.
+ok $duration =~ /\./;