The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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");