@@ -1,5 +1,21 @@
Revision history for Perl extension Net::Ping::External.
+In future Net::Ping::External may require perl 5.6.
+If you use perl older than 5.6 - write to alexchorny[AT]gmail.com
+and tell me what perl version do you use, why and will you need
+newer versions of Net::Ping::External.
+
+0.15 2014-04-12
+- Better detect Windows ping under Cygwin
+- Add ping output for test 2 if it fails
+- Support MidnightBSD
+
+0.14 2013-10-29
+- trailing dot for unexistent host in test (Marcin Gryszkalis)
+- SCO OpenServer added
+- tests will not fail if nonexisting domain resolves
+- detect Windows ping under Cygwin (Ben Bullock)
+
0.13 Dec 18 2008
- Small fixes in test
- Support of count param on RedHat-based systems and SuSE
@@ -6,15 +6,15 @@ package Net::Ping::External;
# Copyright (c) 2001-2003 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.
-# Copyright (c) 2006-2008 Alexandr Ciornii
+# Copyright (c) 2006-2014 Alexandr Ciornii
use strict;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG);
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG $DEBUG_OUTPUT $LAST_OUTPUT $LAST_EXIT_CODE);
use Carp;
use Socket qw(inet_ntoa);
require Exporter;
-$VERSION = "0.13";
+$VERSION = "0.15";
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw(ping);
@@ -46,11 +46,13 @@ sub ping {
darwin => \&_ping_darwin,
openbsd => \&_ping_unix,
freebsd => \&_ping_freebsd,
+ midnightbsd => \&_ping_freebsd,
next => \&_ping_next,
unicosmk => \&_ping_unicosmk,
netbsd => \&_ping_netbsd,
irix => \&_ping_unix,
aix => \&_ping_aix,
+ svr5 => \&_ping_unix, #SCO OpenServer
);
my $subref = $dispatch{lc $^O};
@@ -67,8 +69,10 @@ sub _ping_win32 {
$args{timeout} *= 1000; # Win32 ping timeout is specified in milliseconds
#for each ping
my $command = "ping -l $args{size} -n $args{count} -w $args{timeout} $args{host}";
- print "$command\n" if $DEBUG;
+ print "#$command\n" if $DEBUG;
my $result = `$command`;
+ $LAST_OUTPUT = $result if $DEBUG_OUTPUT;
+ $LAST_EXIT_CODE = $!;
return 1 if $result =~ /time.*ms/;
return 1 if $result =~ /TTL/;
return 1 if $result =~ /is alive/; # ppt (from CPAN) ping
@@ -81,14 +85,16 @@ sub _ping_win32 {
# name)
# Thanks to Peter N. Lewis for this one.
sub _ping_darwin {
- my %args = @_;
- my $command = "ping -s $args{size} -c $args{count} $args{host}";
- my $devnull = "/dev/null";
- $command .= " 2>$devnull";
- print "$command\n" if $DEBUG;
- my $result = `$command`;
- return 1 if $result =~ /(\d+) packets received/ && $1 > 0;
- return 0;
+ my %args = @_;
+ my $command = "ping -s $args{size} -c $args{count} $args{host}";
+ my $devnull = "/dev/null";
+ $command .= " 2>$devnull";
+ print "#$command\n" if $DEBUG;
+ my $result = `$command`;
+ $LAST_OUTPUT = $result if $DEBUG_OUTPUT;
+ $LAST_EXIT_CODE = $!;
+ return 1 if $result =~ /(\d+) packets received/ && $1 > 0;
+ return 0;
}
# Generic subroutine to handle pinging using the system() function. Generally,
@@ -102,7 +108,8 @@ sub _ping_system {
my $devnull = "/dev/null";
$command .= " 1>$devnull 2>$devnull";
print "#$command\n" if $DEBUG;
- my $exit_status = system($command) >> 8;
+ $LAST_EXIT_CODE = system($command);
+ my $exit_status = $LAST_EXIT_CODE >> 8;
return 1 if $exit_status == $success;
return 0;
}
@@ -222,11 +229,17 @@ sub _ping_freebsd {
#No timeout
#Usage: ping [-dfqrv] host [packetsize [count [preload]]]
sub _ping_cygwin {
+ my $which_ping = `which ping`;
+ if (!$which_ping) {
+ return;
+ }
+ if ($which_ping =~ m#/cygdrive/\w/WINDOWS/SYSTEM32/ping#i) {
+ return _ping_win32(@_);
+ }
my %args = @_;
my $command = "ping $args{host} $args{size} $args{count}";
return _ping_system($command, 0);
}
-#Problem is that we may be running windows ping
1;
@@ -234,7 +247,7 @@ __END__
=head1 NAME
-Net::Ping::External - Cross-platform interface to ICMP "ping" utilities
+Net::Ping::External - Cross-platform Perl interface to "ping" utilities
=head1 SYNOPSIS
@@ -5,4 +5,5 @@ Makefile.PL
README
test.pl
ToDo
-META.yml Module meta-data (added by MakeMaker)
+META.yml Module meta-data (added by MakeMaker)
+META.json Module JSON meta-data (added by MakeMaker)
@@ -0,0 +1,50 @@
+{
+ "abstract" : "Cross-platform Perl interface to \"ping\" utilities",
+ "author" : [
+ "Alexandr Ciornii <alexchorny@gmail.com>"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 6.78, CPAN::Meta::Converter version 2.131490",
+ "keywords" : [
+ "ping"
+ ],
+ "license" : [
+ "perl_5"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "Net-Ping-External",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "Carp" : "0",
+ "Socket" : "0"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "repository" : {
+ "url" : "http://github.com/chorny/Net-Ping-External"
+ }
+ },
+ "version" : "0.15"
+}
@@ -1,21 +1,27 @@
---- #YAML:1.0
-name: Net-Ping-External
-version: 0.13
-abstract: Cross-platform interface to ICMP "ping" utilities
+---
+abstract: Cross-platform Perl interface to "ping" utilities
author:
- - Alexandr Ciornii <alexchorny@gmail.com>
-license: perl
-distribution_type: module
+ - 'Alexandr Ciornii <alexchorny@gmail.com>'
+build_requires:
+ ExtUtils::MakeMaker: 0
configure_requires:
- ExtUtils::MakeMaker: 0
-requires:
- Carp: 0
- Socket: 0
-no_index:
- directory:
- - t
- - inc
-generated_by: ExtUtils::MakeMaker version 6.48
+ ExtUtils::MakeMaker: 0
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 6.78, CPAN::Meta::Converter version 2.131490'
+keywords:
+ - ping
+license: perl
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: Net-Ping-External
+no_index:
+ directory:
+ - t
+ - inc
+requires:
+ Carp: 0
+ Socket: 0
+resources:
+ repository: http://github.com/chorny/Net-Ping-External
+version: 0.15
@@ -1,15 +1,48 @@
-use ExtUtils::MakeMaker;
-WriteMakefile(
- 'NAME' => 'Net::Ping::External',
- ($] >= 5.005 ? ## Add these new keywords supported since 5.005
- (ABSTRACT_FROM => 'External.pm', # retrieve abstract from module
- AUTHOR => 'Alexandr Ciornii <alexchorny@'.'gmail.com>') : ()),
- 'VERSION_FROM' => 'External.pm', # finds $VERSION
- ($ExtUtils::MakeMaker::VERSION ge '6.31'?
- ('LICENSE' => 'perl', ) : ()),
- 'PREREQ_PM' => {
- Socket => 0,
- Carp => 0,
-# perl => '5.4',
- },
-);
+use ExtUtils::MakeMaker;
+WriteMakefile1(
+ 'NAME' => 'Net::Ping::External',
+ ABSTRACT_FROM => 'External.pm', # retrieve abstract from module
+ AUTHOR => 'Alexandr Ciornii <alexchorny@'.'gmail.com>',
+ 'VERSION_FROM' => 'External.pm', # finds $VERSION
+ 'LICENSE' => 'perl',
+ 'PREREQ_PM' => {
+ Socket => 0,
+ Carp => 0,
+ },
+ META_MERGE => {
+ resources => {
+ repository => 'http://github.com/chorny/Net-Ping-External',
+ },
+ keywords => ['ping',],
+ },
+ $^O =~/win/i ? (
+ dist => {
+ TAR => 'ptar',
+ TARFLAGS => '-c -C -f',
+ },
+ ) : (),
+);
+
+sub WriteMakefile1 { #Written by Alexandr Ciornii, version 0.21. Added by eumm-upgrade.
+ my %params=@_;
+ my $eumm_version=$ExtUtils::MakeMaker::VERSION;
+ $eumm_version=eval $eumm_version;
+ die "EXTRA_META is deprecated" if exists $params{EXTRA_META};
+ die "License not specified" if not exists $params{LICENSE};
+ if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) {
+ #EUMM 6.5502 has problems with BUILD_REQUIRES
+ $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} };
+ delete $params{BUILD_REQUIRES};
+ }
+ delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52;
+ delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48;
+ delete $params{META_MERGE} if $eumm_version < 6.46;
+ delete $params{META_ADD} if $eumm_version < 6.46;
+ delete $params{LICENSE} if $eumm_version < 6.31;
+ delete $params{AUTHOR} if $] < 5.005;
+ delete $params{ABSTRACT_FROM} if $] < 5.005;
+ delete $params{BINARY_LOCATION} if $] < 5.005;
+
+ WriteMakefile(%params);
+}
+
@@ -1,130 +1,168 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-BEGIN { $| = 1; $num_tests = 6; print "1..$num_tests\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Net::Ping::External qw(ping);
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
-
-# Insert your test code below (better if it prints "ok 13"
-# (correspondingly "not ok 13") depending on the success of chunk 13
-# of the test code):
-
-%test_names = (1 => "use Net::Ping::External qw(ping)",
- 2 => "ping(host => '127.0.0.1')",
- 3 => "ping(host => '127.0.0.1', timeout => 5)",
- 4 => "ping(host => 'some.non.existent.host')",
- 5 => "ping(host => '127.0.0.1', count => 10)",
- 6 => "ping(host => '127.0.0.1', size => 32)"
- );
-
-@passed = ();
-@failed = ();
-push @passed, 1 if $loaded;
-push @failed, 1 unless $loaded;
-
-eval { $ret = ping(host => '127.0.0.1') };
-if (!$@ && $ret) {
- print "ok 2\n";
- push @passed, 2;
-}
-else {
- print "not ok 2\n";
- push @failed, 2;
-}
-
-eval { $ret = ping(host => '127.0.0.1', timeout => 5) };
-if (!$@ && $ret) {
- print "ok 3\n";
- push @passed, 3;
-}
-else {
- print "not ok 3\n";
- push @failed, 3;
-}
-
-eval { $ret = ping(host => 'some.non.existent.host') };
-if (!$@ && !$ret) {
- print "ok 4\n";
- push @passed, 4;
-}
-else {
- print "not ok 4\n";
- push @failed, 4;
-}
-
-eval { $ret = ping(host => '127.0.0.1', count => 2) };
-if (!$@ && $ret) {
- print "ok 5\n";
- push @passed, 5;
-}
-else {
- print "not ok 5\n";
- push @failed, 5;
-}
-
-eval { $ret = ping(host => '127.0.0.1', size => 32) };
-if (!$@ && $ret) {
- print "ok 6\n";
- push @passed, 6;
-}
-else {
- print "not ok 6\n";
- push @failed, 6;
-}
-
-print "\nRunning a more verbose test suite.";
-print "\n-------------------------------------------------\n";
-print "Net::Ping::External version: ", $Net::Ping::External::VERSION, "\n";
-print scalar(@passed), "/$num_tests tests passed.\n\n";
-
-if (@passed) {
- print "Successful tests:\n";
- foreach (@passed) {
- print "$test_names{$_}\n";
- }
-}
-
-if (@failed) {
- print "\nFailed tests:\n";
- foreach (@failed) {
- print "$test_names{$_}\n";
- }
-}
-
-my @output = `$^X -v`;
-my $a='';
-$a.= "\nOperating system according to perl: ".$^O."\n";
-$a.= "Operating system according to `uname -a` (if available):\n";
-$a.= `uname -a`;
-$a.= "Perl version: ";
-$a.= @output[1..1];
-$a.= "Ping help: ";
-my $ping=($^O eq 'Netbsd'?Net::Ping::External::_locate_ping_netbsd():'ping');
-$a.= `$ping 2>&1`;
-$a.="\n";
-if (@failed and $failed[0]==5 and lc($^O) eq 'linux') {
- $a.="-\nping -c 1 some.non.existent.host\n";
- $a.=`ping -c 1 some.non.existent.host`;
- $a.="\n-\n";
-}
-open A,'>NPE.out';
-print A $a;
-close A;
-print $a;
-print "-------------------------------------------------\n";
-print "If any of the above tests failed, please e-mail the bits between the dashed\n";
-print "lines or content of 'NPE.out' to alexchorny AT gmail.com This will help me in\n";
-print "fixing this code for maximum portability to your platform. Thanks!\n";
-
-print "\nTests: ".(@failed?"fail":"ok")."\n";
-exit (@failed?1:0);
-
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; $num_tests = 6; print "1..$num_tests\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Net::Ping::External qw(ping);
+$loaded = 1;
+print "ok 1\n";
+
+$Net::Ping::External::DEBUG_OUTPUT = 1;
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+%test_names = (1 => "use Net::Ping::External qw(ping)",
+ 2 => "ping(host => '127.0.0.1')",
+ 3 => "ping(host => '127.0.0.1', timeout => 5)",
+ 4 => "ping(host => 'some.non.existent.host.')",
+ 5 => "ping(host => '127.0.0.1', count => 10)",
+ 6 => "ping(host => '127.0.0.1', size => 32)"
+ );
+
+@passed = ();
+@failed = ();
+push @passed, 1 if $loaded;
+push @failed, 1 unless $loaded;
+
+my $output_test_2;
+my $exit_test_2;
+my $error_test_2;
+
+eval { $ret = ping(host => '127.0.0.1') };
+if (!$@ && $ret) {
+ print "ok 2\n";
+ push @passed, 2;
+}
+else {
+ print "not ok 2\n";
+ push @failed, 2;
+ $output_test_2 = $Net::Ping::External::LAST_OUTPUT;
+ $exit_test_2 = $Net::Ping::External::LAST_EXIT_CODE;
+ if ($@) {
+ $error_test_2 = $@;
+ }
+}
+
+eval { $ret = ping(host => '127.0.0.1', timeout => 5) };
+if (!$@ && $ret) {
+ print "ok 3\n";
+ push @passed, 3;
+}
+else {
+ print "not ok 3\n";
+ push @failed, 3;
+}
+
+sub inexistent_domain_do_not_resolve {
+ use Socket;
+ return 1 unless inet_aton('some.non.existent.host.');
+ return 0;
+}
+
+if (inexistent_domain_do_not_resolve()) {
+ eval { $ret = ping(host => 'some.non.existent.host.') };
+ if (!$@ && !$ret) {
+ print "ok 4\n";
+ push @passed, 4;
+ }
+ else {
+ print "not ok 4\n";
+ push @failed, 4;
+ }
+} else {
+ push @passed, 4;
+ print "ok 4 #skipped\n";
+}
+
+eval { $ret = ping(host => '127.0.0.1', count => 2) };
+if (!$@ && $ret) {
+ print "ok 5\n";
+ push @passed, 5;
+}
+else {
+ print "not ok 5\n";
+ push @failed, 5;
+}
+
+eval { $ret = ping(host => '127.0.0.1', size => 32) };
+if (!$@ && $ret) {
+ print "ok 6\n";
+ push @passed, 6;
+}
+else {
+ print "not ok 6\n";
+ push @failed, 6;
+}
+
+print "\nRunning a more verbose test suite.";
+print "\n-------------------------------------------------\n";
+print "Net::Ping::External version: ", $Net::Ping::External::VERSION, "\n";
+print scalar(@passed), "/$num_tests tests passed.\n\n";
+
+if (@passed) {
+ print "Successful tests:\n";
+ foreach (@passed) {
+ print "$test_names{$_}\n";
+ }
+}
+
+if (@failed) {
+ print "\nFailed tests:\n";
+ foreach (@failed) {
+ print "$test_names{$_}\n";
+ }
+}
+
+my @output = `$^X -v`;
+my $a='';
+$a.= "\nOperating system according to perl: ".$^O."\n";
+if ($^O ne 'MSWin32') {
+ $a.= "Operating system according to `uname -a` (if available):\n";
+ $a.= `uname -a`;
+}
+$a.= "Perl version: ";
+$a.= @output[1..1];
+if ($^O ne 'MSWin32') {
+ $a.= "Ping location: ".`which ping`;
+}
+$a.= "Ping help: ";
+my $ping=($^O eq 'Netbsd'?Net::Ping::External::_locate_ping_netbsd():'ping');
+my $usage='';
+if ($^O eq 'gnukfreebsd') {
+ $usage = '--help';
+}
+$a.= `$ping $usage 2>&1`;
+$a.="\n";
+if (@failed and $failed[0]==5 and lc($^O) eq 'linux') {
+ $a.="-\nping -c 1 some.non.existent.host\n";
+ $a.=`ping -c 1 some.non.existent.host`;
+ $a.="\n-\n";
+}
+if (@failed and $failed[0]==2) {
+ $a.="-\nresults for test 2:\n";
+ $a.="exit code for test 2: $exit_test_2\n";
+ $a.="output for test 2: $output_test_2" if defined $output_test_2;
+ $a.="\$\@ for test 2: $error_test_2" if $error_test_2;
+ $a.="\n-\n";
+}
+
+open A,'>NPE.out';
+print A $a;
+close A;
+print $a;
+print "-------------------------------------------------\n";
+print "If any of the above tests failed, please e-mail the bits between the dashed\n";
+print "lines or content of 'NPE.out' to alexchorny AT gmail.com This will help me in\n";
+print "fixing this code for maximum portability to your platform. Thanks!\n";
+
+print "\nTests: ".(@failed?"fail":"ok")."\n";
+exit (@failed?1:0);
+