Update Net::Ping from 2.40 to 2.41
authorMax Maischein <corion@cpan.org>
Thu, 21 Mar 2013 19:51:11 +0000 (20:51 +0100)
committerMax Maischein <corion@cpan.org>
Thu, 21 Mar 2013 19:51:11 +0000 (20:51 +0100)
This is necessary to make tests pass on Windows (XP and onward).

Porting/Maintainers.pl
dist/Net-Ping/Changes
dist/Net-Ping/lib/Net/Ping.pm
dist/Net-Ping/t/250_ping_hires.t

index 0f3e31c..c60b66b 100755 (executable)
@@ -1330,8 +1330,12 @@ use File::Glob qw(:case);
 
     'Net::Ping' => {
         'MAINTAINER'   => 'smpeters',
-        'DISTRIBUTION' => 'SMPETERS/Net-Ping-2.40.tar.gz',
+        'DISTRIBUTION' => 'SMPETERS/Net-Ping-2.41.tar.gz',
         'FILES'        => q[dist/Net-Ping],
+        'EXCLUDED'     => [
+            qr{^.travis.yml},
+            qr{^README.md},
+        ],
         'UPSTREAM'     => 'blead',
     },
 
index 47dddbe..fa26c68 100644 (file)
@@ -1,29 +1,37 @@
 CHANGES
 -------
+2.41  Mar 17 09:35 2013
+        Bugfixes
+        - Windows Vista does not appear to support inet_ntop().  It seems to
+          have InetNtop() instead.  So, working around by using getnameinfo()
+          and passing in the NI_NUMERICHOST to get an IP address.
+        Features
+        - Change Net::Ping to use Time::HiRes::time() instead of CORE::time()
+          by default.  For most successful cases, CORE::time() returned zero.
 2.40  Mar 15 11:20 2013
         Bugfixes
-        - several fixes to tests to stop the black smoke on Win32's 
+        - several fixes to tests to stop the black smoke on Win32's
           and Cygwin since the core updated the module to Test::More.
           I had planned a later release, but all the black smoke is
           forcing a release.
-        - fixes to some skips in tests that were still using the 
+        - fixes to some skips in tests that were still using the
           Test style skip's.
         - Documentation fix for https://rt.cpan.org/Ticket/Display.html?id=48014.
           Thanks to Keith Taylor <keith@supanet.net.uk>
-        - Instead of using a hard-coded TOS value, import IP_TOS from 
-          Socket.  This fixes an outstanding bug on Solaris which uses a 
+        - Instead of using a hard-coded TOS value, import IP_TOS from
+          Socket.  This fixes an outstanding bug on Solaris which uses a
           different value for IP_TOS in it headers than Linux.  I'm assuming
           other OS's were fixed with this change as well.
 
         Features
-        - added TTL handling for icmp pings to allow traceroute like 
-          applications to be built with Net::Ping.  Thanks to 
+        - added TTL handling for icmp pings to allow traceroute like
+          applications to be built with Net::Ping.  Thanks to
           <rolek@bokxing.nl> for the patch and tests!
 
-        Internals
-        - replaced SOL_IP with IPPROTO_IP.  SOL_IP is not portable and was 
+       Internals
+        - replaced SOL_IP with IPPROTO_IP.  SOL_IP is not portable and was
           hard-coded anyway.
-        - added IPPROTO_IP, IP_TOS, IP_TTL, and AF_INET to the list of Socket 
+        - added IPPROTO_IP, IP_TOS, IP_TTL, and AF_INET to the list of Socket
           constants imported.
         - removed some hard-coded constants.
         - converted all calls to inet_ntoa() to inet_ntop() in preparation
@@ -34,8 +42,8 @@ CHANGES
           recent Socket
         - several changes for github hosting
           - add a .gitignore file
-          - added a .travis.yml file to allow CI testing with pushed to
-            github
+          - added a .travis.yml file to allow CI testing with changes pushed
+            to github
           - replaced the README with a README.md which displays the
             Travis CI build status on github.
 
@@ -48,7 +56,7 @@ CHANGES
         - release to include a few fixes from the Perl core
 
 2.35  Feb 08 14:42 2008
-       - Patch in Perl change #33242 by Nicholas Clark 
+       - Patch in Perl change #33242 by Nicholas Clark
                <http://perl5.git.perl.org/perl.git/commit/5d6b07c5a4c042580b85248d570ee299fd102a79>
 
 2.34  Dec 19 08:51 2007
index a4d4a50..1523af9 100644 (file)
@@ -9,14 +9,15 @@ use vars qw(@ISA @EXPORT $VERSION
             $max_datasize $pingstring $hires $source_verify $syn_forking);
 use Fcntl qw( F_GETFL F_SETFL O_NONBLOCK );
 use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET SOL_SOCKET SO_ERROR IPPROTO_IP IP_TOS IP_TTL
-               inet_aton inet_ntop AF_INET sockaddr_in );
+               inet_aton getnameinfo NI_NUMERICHOST sockaddr_in );
 use POSIX qw( ENOTCONN ECONNREFUSED ECONNRESET EINPROGRESS EWOULDBLOCK EAGAIN WNOHANG );
 use FileHandle;
 use Carp;
+use Time::HiRes;
 
 @ISA = qw(Exporter);
 @EXPORT = qw(pingecho);
-$VERSION = "2.40";
+$VERSION = "2.41";
 
 # Constants
 
@@ -312,13 +313,12 @@ sub retrans
 # Description: allows the module to use milliseconds as returned by
 # the Time::HiRes module
 
-$hires = 0;
+$hires = 1;
 sub hires
 {
   my $self = shift;
   $hires = 1 unless defined
     ($hires = ((defined $self) && (ref $self)) ? shift() : $self);
-  require Time::HiRes if $hires;
 }
 
 sub time
@@ -400,7 +400,7 @@ sub ping
     croak("Unknown protocol \"$self->{proto}\" in ping()");
   }
 
-  return wantarray ? ($ret, &time() - $ping_time, inet_ntop(AF_INET, $ip)) : $ret;
+  return wantarray ? ($ret, &time() - $ping_time, $self->ntop($ip)) : $ret;
 }
 
 # Uses Net::Ping::External to do an external ping.
@@ -501,7 +501,7 @@ sub ping_icmp
       $self->{"from_subcode"} = $from_subcode;
       next if ($from_pid != $self->{"pid"});
       next if ($from_seq != $self->{"seq"});
-      if (! $source_verify || (inet_ntop(AF_INET, $from_ip) eq inet_ntop(AF_INET, $ip))) { # Does the packet check out?
+      if (! $source_verify || ($self->ntop($from_ip) eq $self->ntop($ip))) { # Does the packet check out?
         if ($from_type == ICMP_ECHOREPLY) {
           $ret = 1;
                $done = 1;
@@ -523,7 +523,7 @@ sub icmp_result {
   my ($self) = @_;
   my $ip = $self->{"from_ip"} || "";
   $ip = "\0\0\0\0" unless 4 == length $ip;
-  return (inet_ntop(AF_INET, $ip),($self->{"from_type"} || 0), ($self->{"from_subcode"} || 0));
+  return ($self->ntop($ip),($self->{"from_type"} || 0), ($self->{"from_subcode"} || 0));
 }
 
 # Description:  Do a checksum on the message.  Basically sum all of
@@ -1260,7 +1260,7 @@ sub ack
           }
           # Everything passed okay, return the answer
           return wantarray ?
-            ($entry->[0], &time() - $entry->[3], inet_ntop(AF_INET, $entry->[1]))
+            ($entry->[0], &time() - $entry->[3], $self->ntop($entry->[1]))
             : $entry->[0];
         } else {
           warn "Corrupted SYN entry: unknown fd [$fd] ready!";
@@ -1296,7 +1296,7 @@ sub ack_unfork {
     # Host passed as arg
     if (my $entry = $self->{"good"}->{$host}) {
       delete $self->{"good"}->{$host};
-      return ($entry->[0], &time() - $entry->[3], inet_ntop(AF_INET, $entry->[1]));
+      return ($entry->[0], &time() - $entry->[3], $self->ntop($entry->[1]));
     }
   }
 
@@ -1340,7 +1340,7 @@ sub ack_unfork {
               # And wait for the next winner
               next;
             }
-            return ($entry->[0], &time() - $entry->[3], inet_ntop(AF_INET, $entry->[1]));
+            return ($entry->[0], &time() - $entry->[3], $self->ntop($entry->[1]));
           }
         } else {
           # Should never happen
@@ -1403,6 +1403,23 @@ sub port_number {
    return $self->{port_num};
 }
 
+sub ntop {
+    my($self, $ip) = @_;
+
+    # Vista doesn't define a inet_ntop.  It has InetNtop instead.
+    # Not following ANSI... priceless.  getnameinfo() is defined
+    # for Windows 2000 and later, so that may be the choice.
+
+    # Any port will work, even undef, but this will work for now.
+    # Socket warns when undef is passed in, but it still works.
+    my $port = getservbyname('echo', 'udp');
+    my $sockaddr = sockaddr_in $port, $ip;
+    my ($error, $address) = getnameinfo($sockaddr, NI_NUMERICHOST);
+    if($error) {
+      croak $error;
+    }
+    return $address;
+}
 
 1;
 __END__
index 34e81a8..6c5be69 100644 (file)
@@ -30,7 +30,7 @@ my $p = new Net::Ping "tcp";
 
 isa_ok($p, 'Net::Ping', 'new() worked');
 
-is($Net::Ping::hires, 0, 'Default is to not use Time::HiRes');
+is($Net::Ping::hires, 1, 'Default is to use Time::HiRes');
 
 $p -> hires();
 isnt($Net::Ping::hires, 0, 'Enabled hires');