1use warnings; 2use strict; 3 4BEGIN { 5 unless (my $port = getservbyname('echo', 'tcp')) { 6 print "1..0 \# Skip: no echo port\n"; 7 exit; 8 } 9} 10 11use Test::More qw(no_plan); 12BEGIN {use_ok('Net::Ping')}; 13 14# plain ol' constuctor call 15my $p = Net::Ping->new(); 16isa_ok($p, "Net::Ping"); 17 18# call new from an instantiated object 19my $p2 = $p->new(); 20isa_ok($p2, "Net::Ping"); 21 22# named args 23my $p3 = Net::Ping->new({proto => 'tcp', ttl => 5}); 24isa_ok($p3, "Net::Ping"); 25 26# check for invalid proto 27eval { 28 $p = Net::Ping->new("thwackkk"); 29}; 30like($@, qr/Protocol for ping must be "icmp", "icmpv6", "udp", "tcp", "syn", "stream" or "external"/, "new() errors for invalid protocol"); 31 32# check for invalid timeout 33eval { 34 $p = Net::Ping->new("tcp", -1); 35}; 36like($@, qr/Default timeout for ping must be greater than 0 seconds/, "new() errors for invalid timeout"); 37 38# check for invalid data sizes 39eval { 40 $p = Net::Ping->new("udp", 10, -1); 41}; 42like($@, qr/Data for ping must be from/, "new() errors for invalid data size"); 43 44eval { 45 $p = Net::Ping->new("udp", 10, 1025); 46}; 47like($@, qr/Data for ping must be from/, "new() errors for invalid data size"); 48 49# force failures for udp 50 51 52# force failures for tcp 53SKIP: { 54 note "Checking icmp"; 55 eval { $p = Net::Ping->new('icmp'); }; 56 skip "icmp ping requires root privileges.", 3 57 if !Net::Ping::_isroot() or $^O eq 'MSWin32'; 58 if($> and $^O ne 'VMS' and $^O ne 'cygwin') { 59 like($@, qr/icmp ping requires root privilege/, "Need root for icmp"); 60 skip "icmp tests require root", 2; 61 } else { 62 isa_ok($p, "Net::Ping"); 63 } 64 65 # set IP TOS to "Minimum Delay" 66 $p = Net::Ping->new("icmp", undef, undef, undef, 8); 67 isa_ok($p, "Net::Ping"); 68 69 # This really shouldn't work. Not sure who to blame. 70 $p = Net::Ping->new("icmp", undef, undef, undef, "does this fail"); 71 isa_ok($p, "Net::Ping"); 72} 73 74