#!/usr/bin/perl use strict; use warnings; BEGIN { $| = 1; if ($> and ($^O ne 'VMS')) { print "1..0 # skipped: Traceroute requires root privilege\n"; exit 0; } }; use Net::Traceroute::PurePerl; use Test::More tests => 5; sub DEBUG () { return 0 } my $host = 'www.perl.org'; my $t = ""; eval { $t = Net::Traceroute::PurePerl->new( host => $host, debug => DEBUG, first_hop => 1, base_port => 33434, max_ttl => 15, query_timeout => 3, queries => 3, source_address => '0.0.0.0', packetlen => 40, protocol => 'udp', concurrent_hops => 6, device => undef, ); }; ok( ref $t eq 'Net::Traceroute::PurePerl', 'Object created successfully' ) or diag($@); if ($t) { my $success; eval { local $SIG{ALRM} = sub { die "alarm" }; alarm 30; # Should never take longer than 24 seconds $success = $t->traceroute; alarm 0; }; ok( defined $success, 'Traceroute completed successfully' ) or diag($@); my $success2; eval { $t->protocol('icmp'); local $SIG{ALRM} = sub { die "alarm timed out" }; alarm 30; # Should never take longer than 24 seconds $success2 = $t->traceroute; alarm 0; }; ok( defined $success2, 'ICMP Traceroute completed successfully' ) or diag($@); } else { foreach (1 .. 2) { fail('Could not create trace object'); } eval { $t = Net::Traceroute::PurePerl->new() }; } eval { $t->protocol('notimplemented'); $t->traceroute; }; ok( $@ =~ /Parameter `protocol\'/, "Bad protocol detected successfully" ); eval { $t->protocol('icmp'); $t->host('badhost.x'); $t->traceroute; }; ok( $@ =~ /Could not resolve host/, "Bad host detected successfully" ); # The clone method currently fails # my $t2; # eval { # $t = Net::Traceroute::PurePerl->new(host => 'www.perl.org', queries=>'2'); # $t2 = $t->clone(); # }; # is_deeply($t, $t2, "Clone works") or diag ("Clone failed");