http://paperlined.org/dev/src/pl/ping_cable_modem.pl

#!/usr/bin/perl

# This launches a bunch of different commands in different Screen windows, so that they all display
# at once.
#       http://en.wikipedia.org/wiki/GNU_Screen
#
#
# Remember, to exit Screen, use ctrl-A \

    use strict;
    use warnings;

    use File::Temp;
    use IO::BufferedSelect;
    use Data::Dumper;

my $interface = "eth1";

our @windows_to_open = (
    [$0, "arping", "-I", $interface, "192.168.1.199"],
    [$0, "arping", "-I", $interface, "192.168.1.254"],
    [$0, "ping", "99.140.223.254"],
    [$0, "ping", "4.2.2.2"],
    [$0, "dig", "google.com", "192.168.1.254", "+time=2"],
);


if ($ENV{RECORD_SCREEN_PID}) {
    open my $fout, ">$ENV{RECORD_SCREEN_PID}"   or die $!;
    print $fout getppid();
    close $fout;
}

# are we running inside Screen?
if ($ENV{WINDOW}) {
    # if so, set up a Ctrl-C handler that will kill ALL screen windows, as soon as any one of them is killed
    $SIG{INT} = sub {
        my $screen_pid = getppid();
        system "screen", "-x", $screen_pid, "-X", "quit";
    }
}


# to start this script normally, don't use any command-line parameters
if (!@ARGV) {
    # Arping really requires root.  So restart as root if we need to.
    $> == 0    or exec "sudo", $0;

    launch_multiwindow();

# if command-line parameters are sent, then we run the specific sub-command
} else {
    # update the title of this window
    my $title = join(" ", @ARGV);
    print "\ek$title\e\\";
    
    #if ($ENV{WINDOW} == 0) {
        #sleep(1);       # delay JUST a little, because the "resize =" command we run has a tendency to chop off a few lines otherwise
        select(undef,undef,undef,0.4);
    #}

    my $cmd = shift @ARGV;
    if ($cmd eq 'wait') {
        foreach (1..999) {
            print "waiting....  $_\n";
            sleep 1;
        }
        exit;
    } elsif ($cmd eq 'ping') {
        ping("ping", @ARGV);
        exit;
    } elsif ($cmd eq 'arping') {
        arping("arping", @ARGV);
        exit;
    } elsif ($cmd eq 'dig') {
        dig("dig", @ARGV);
        sleep 100;
        exit;
    } else {
        print "Unknown command: ", Dumper [$cmd, @ARGV];
        sleep 100;
        exit;
    }
}





sub launch_multiwindow {
    my ($fh, $screen_pid_tempfile) = File::Temp::tempfile();
    close $fh;

    # run screen, and tell screen to run us, and when it runs us, tell ourselves to record the $PPID into $screen_pid_tempfile
    $ENV{RECORD_SCREEN_PID} = $screen_pid_tempfile;

    # the first window gets started a little differently...  it gets started when the main screen PID gets started
    my $first_window = shift(@windows_to_open);
    my $screen_pid = fork();
    if ($screen_pid == 0) {
        exec "screen", @$first_window;
    }

    # Wait for the pid file to be written to by the first screen
    my $deadline = time() + 2;
    while (time() <= $deadline) {
        last if (-s $screen_pid_tempfile);
        select undef, undef, undef, 0.25;
    }
    -s $screen_pid_tempfile or die "Unable to find Screen's PID\n";
    

    # for some reason, $screen_pid isn't the one that we can use for '-x'...
    #       $real_screen_pid ends up being one of the immediate children of $screen_pid
    my $real_screen_pid = catfile($screen_pid_tempfile);

    my @screen_command = ("screen", "-x", $real_screen_pid, "-X");
    my @create_new_window = (@screen_command, "screen", "1");

    foreach my $window_command (@windows_to_open) {
        system @screen_command, "split";
        system @screen_command, "focus", "down";
        system @create_new_window, @$window_command;
    }

    system @screen_command, "resize", "=";      # make all regions equally high

    waitpid($screen_pid, 0);
    exit;
}



# like normal 'ping', but with a little wrapper around it to display the time that a packet was printed

sub ping {
    my (@ping_arguments) = @_;

    open my $pin, "-|", @ping_arguments     or die $!;

    my $host = $ping_arguments[-1];     # just assume/guess wildly, that it's the last argument

    while (defined(local $_ = foreach_bufferedselect($pin, 2))) {
        if (ref($_)) {
            print scalar(localtime), "    timed out ($host)\n";
            next;
        }
        chomp;
        print scalar(localtime()), "    $_\n";
    }
    exit;       # EOF
}



# apt-get install arping
sub arping {
    my (@arping_arguments) = @_;

    open my $pin, "-|", @arping_arguments     or die $!;
    while (defined(local $_ = foreach_bufferedselect($pin, 2))) {
        if (ref($_)) {
            print scalar(localtime), "    timed out\n";
        } else {
            print;
        }
    }
}



sub dig {
    my (@dig_arguments) = @_;

    while (1) {
        my $start_time = localtime();
        open my $pin, "-|", @dig_arguments  or do {print $!; sleep 100; exit};
        my @query_times;
        my $total_query_time = 0;
        my $last_was_question = 0;
        my $queried_for = '';
        my $timed_out;
        while (<$pin>) {
            if (/query time: (\d+)/i) {
                push(@query_times, $1);
                $total_query_time += $1;
            }
            if (/connection timed out/i) {
                $timed_out++;
            }
            if ($last_was_question && !$queried_for) {
                ($queried_for) = split ' ', $_;
                $queried_for =~ s/^;|\.$//g;
            }
            $last_was_question = 0;
            $last_was_question = 1 if (/QUESTION SECTION/);
        }
        close $pin;
        #print "$start_time  --- ", join(" ", @query_times), "\n";
        #print "$start_time  --- $total_query_time --- ", join(" ", @dig_arguments), "\n";
        if ($timed_out) {
            print "$start_time  --- timeout\n";
            next;
        }
        print "$start_time  --- $queried_for ---  $total_query_time\n";
        my $remainder = 1000 - $total_query_time;       # milliseconds left to sleep
        if ($remainder > 0) {
            #sleep($remainder/1000);
            select undef, undef, undef, $remainder/1000;
        }
        #sleep(2 - $total_query_time/1000);
    }
}




sub catfile {
    my ($filename) = @_;
    -f $filename    or return undef;
    open my $fin, "<$filename"      or die $!;
    my @ret = wantarray ?  <$fin> : do {local $/=undef; <$fin>};
    close $fin;
    wantarray ? @ret : $ret[0];
}


BEGIN {
    # This is a "simple" wrapper around IO::BufferedSelect.
    #
    # It's intended to be used in cases where you just want to do a while (<$fh>)
    # read loop for ONE handle, and the only reason you're using
    # IO::BufferedSelect is to add the ability to do timeouts for that one
    # handle.
    #
    # It returns three possible values:
    #       - a scalar, if a line was returned
    #       - undef, if EOF was encountered
    #       - an array-ref (with just one element -- undef) if a timeout occurred
    my %foreach_bufferedselect;
    sub foreach_bufferedselect {
        my ($fh, $timeout) = @_;

        my $fileno = fileno($fh);
        my $data;
        if (!exists $foreach_bufferedselect{$fileno}) {
            $data = $foreach_bufferedselect{$fileno} = {};
            $data->{bs} = new IO::BufferedSelect($fh);
            $data->{accum} = [];
        } else {
            $data = $foreach_bufferedselect{$fileno};
        }

        if (@{ $data->{accum} }) {
            my $line = shift( @{ $data->{accum} } );
            return _foreach_bufferedselect_ret_one($line);
        }

        my $buf_select = $data->{bs};
        $data->{accum} = [ $buf_select->read_line($timeout) ];

        if ( @{$data->{accum}} == 0 ) {
            my $array_ref = [undef];
            return $array_ref;              # return-type:  timed-out
        } else {
            my $line = shift( @{ $data->{accum} } );
            return _foreach_bufferedselect_ret_one($line);
        }
    }

        # we have one value from the array...  figure out what to return to the caller of foreach_bufferedselect()
        sub _foreach_bufferedselect_ret_one {
            my $line = shift;
            if (!defined($line->[1])) {
                return undef;               # return-type:  EOF
            } else {
                return $line->[1];          # return-type:  text contents of a line
            }
        }
}