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 Net::Pcap::Easy;
use File::Slurp qw(slurp);

use Test; my $pings = 1; my $gets = 1;
plan tests => (my $max = ($pings+$gets) * 3);

# NOTE: there's little doubt with all the time sensitive things going on
# here that I'll see this on the CPAN tresters reports eventually...

my $dev;
if( -s "device" ) {
    $dev = slurp('device');
    chomp $dev;
}

unless( $dev ) {
    warn "   [skipping tests: no device given]\n";
    skip(1, 0,0) for 1 .. $max;
    exit 0;
}
 
eval "use Net::Ping";
if( $@ ) {
    warn "   [skipping tests: no Net::Ping module]\n";
    skip(1, 0,0) for 1 .. $max;
    exit 0;
}

eval "use WWW::Mechanize";
if( $@ ) {
    warn "   [skipping tests: no WWW::Mechanize module]\n";
    skip(1, 0,0) for 1 .. $max;
    exit 0;
}

$SIG{ALRM} = sub { exit 1 }; alarm 15;

my $ppid = $$;
my $kpid = fork;
if( not $kpid ) {
    my $val = 1;
    $SIG{HUP} = sub { $val = 0; };

    sleep 1 while $val;

    my $p = eval { Net::Ping->new('icmp') }; exit 0 if $@; # Net::Ping needs root, warned and described below
       $p->ping("google.com") for 1 .. $pings;
       $p->close;

    my $mech = new WWW::Mechanize;
       $mech->agent("NPE tester");
       $mech->get("http://voltar.org/") for 1 .. $gets;

    exit 0;
}

sub gcb {
    my ($npe, $ether, $ip, $po) = @_;

    ok( $ip->{src_ip},  qr(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}) );
    ok( $ip->{dest_ip}, qr(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}) );
    ok( $npe->is_local( $ip->{src_ip} ) or $npe->is_local( $ip->{dest_ip} ) );
}

my $npe = eval { Net::Pcap::Easy->new(
    dev              => $dev,
    filter           => "icmp or tcp port 80",
    promiscuous      => 0,
    packets_per_loop => $pings+$gets,

    icmp_callback => \&gcb,
     tcp_callback => \&gcb,
)};

my $skip;
if( $@ ) {
    if( $@ =~ m/(?:permission|permitted)/i ) {
        $skip = 1;

    } else {
        die "problem loading npe: $@";
    }
}

kill 1, $kpid;
if( $skip ) {
    warn "   [skipping tests: permission denied, try running as root]\n";
    skip(1, 0,0) for 1 .. $max;

} else {
    $npe->loop;
}

waitpid $kpid, 0;
exit 0;