#!/usr/local/bin/perl
use strict;
use warnings;
use Carp;
use Fcntl;

use constant { DEBUG => 1 };

my $to_ping = [ qw( localhost www.google.com www.slashdot.org ) ];
my $resref = mping(  $to_ping, 'ping', '-s 100', '-c 5', '-w 5' );
my %res = %$resref;
for ( keys %res ) { print "status for $_: " . $res{$_}{'status'} . "\n" };


sub mping {
    my $mypid = $$;

    if ( DEBUG ) {
        print "debug mping\nmy pid is $mypid\n";
        my @ls = `ls -1 /proc/$mypid/fd`;
        chomp @ls;
        printf "%s file descriptors:\n", scalar @ls;
        print join " ", sort { $a <=> $b } @ls;
        print "\n\n";
    }

    my @hosts = @{$_[0]};
    @hosts or die "no hosts to mping";
    my ( $pingcmd, $pingsize, $pingnumber, $pingtimeout ) = @_[1,2,3,4];
    croak "invalid mping arguments" unless $pingcmd and $pingnumber and $pingsize;
    my ( @pings, %results );

    for ( my $i = 0; $i <= $#hosts; $i++ ) {
        $pings[$i][0] = $hosts[$i];
        my $pid = open $pings[$i][1], "-|", "$pingcmd $hosts[$i] $pingsize $pingnumber" or
            die "Error executing $pingcmd: $!\n";

        my $old_flags = fcntl( $pings[$i][1], F_GETFL, 0 )
            or die "can't get flags: $!";

        fcntl( $pings[$i][1], F_SETFL, $old_flags | O_NONBLOCK )
            or die "can't set non blocking: $!";

        $pings[$i][2] = $pid;

        ( printf "spawned ping, pid $pings[$i][2], fileno %s\n", fileno $pings[$i][1] ) if DEBUG;

        print "$pingcmd, $hosts[$i], $pingsize, $pingnumber failure\n" unless $pid;
    }
    ( printf "spawned %s ping commands\n", scalar @pings ) if DEBUG;

    my ( $start, $j )  = ( time,  1);

    ### READ
    while ( @pings ) {

        if ( DEBUG ) {
            print "starting read loop $j\n";
            printf "there are %s pings active\n", scalar @pings;
            print "fd status from /proc/$mypid/fd:\n";

            my @ls = `ls -1 /proc/$mypid/fd`;
            chomp @ls;
            print join " ", sort { $a <=> $b } @ls;
            print "\n";
        }

        for ( my $i = $#pings; $i >= 0; $i-- ) {
            my $buf;
            my $len = sysread $pings[$i][1], $buf, 580;
            if (not defined $len) { # loop
                print "error reading $i: $!\n\n" if DEBUG > 2;
            }
            elsif ($len > 0) { # read, loop
                print "still reading $i\n" if DEBUG > 1;
            }
            elsif ($len == 0) {

                my $fileno =  fileno ( $pings[$i][1] );
                my $rv = close $pings[$i][1];

                if ( DEBUG ) {
                    printf "done reading from pid $pings[$i][2] fd `%s`, closing\n", $fileno;
                    printf "close $pings[$i][2] status: fd: `%s`; rv: `$rv`; \$!: `$!`; \$?: $?\n", $fileno;
                }

                $results{ $pings[$i][0] }{ 'status' } = $? >> 8;
                splice @pings, $i, 1;
            }
            else { die; }
        }

        sleep 2;

        if ( DEBUG ) {
            print "end read loop $j\n";
            printf "there are %s pings active\n", scalar @pings;
            print "fd status from /proc/$mypid/fd:\n";
            my @ls = `ls -1 /proc/$mypid/fd`; chomp @ls;
            print join " ", sort {$a <=> $b} @ls; print "\n";
        }

        $j++;
    }
    return \%results;
}