Concurrent non-blocking connections in perl

gistfile1.txt

use strict;
use Data::Dumper;

my @hosts = (
    '74.125.24.101:80',     # google
    '74.125.24.101:9999',   # google but bad port
    '17.172.224.47:80',     # apple
    '117.53.170.202:80',    # www.gov.au
);

my $connected = parallel_connect(hosts => \@hosts, minimum => 1, timeout => 2);

warn Dumper($connected);

exit 0;


use Fcntl;
use Errno qw(EINPROGRESS EALREADY EISCONN);
use Socket;
use Time::HiRes qw ( time sleep );
use Carp qw(croak);

sub parallel_connect {
    my %opts = @_;
    my $hosts   = delete $opts{hosts} or croak "No hosts specified";
    my $timeout = delete $opts{timeout} || 2.0;
    my $minimum = delete $opts{minimum} || 1;
    croak "Unknown options: @{[ sort keys %opts ]}" if %opts;

    my $end_time = time() + $timeout;
    my $poll_delay = 0.01;
    my $proto = getprotobyname('tcp');

    # create a non-blocking socket for each host
    my %socks = map {
        my $socket;
        my $flags = 0;
        socket($socket, PF_INET, SOCK_STREAM, $proto) || die("socket: $!");
        fcntl($socket, F_GETFL, $flags)               || die("fcntl: $!");
        fcntl($socket, F_SETFL, $flags | O_NONBLOCK)  || die("fcntl: $!");

        # we assume we've been given ip addresses in dotted-quad notation
        # (non-blocking DNS resolution is a whole other ball of wax)
        my ($ip, $port) = split /:/, $_;
        my %sockinfo = ( socket => $socket, ip => $ip, $port => $port );
        my $inet_aton = inet_aton($ip) || die("inet_aton $ip: $!");
        $sockinfo{sockaddr}  = sockaddr_in($port, $inet_aton);
        ($_ => \%sockinfo)
    } @$hosts;


    my %connected;
    while (%socks) {
        while ( my ($host, $sockinfo) = each %socks ) {

            connect($sockinfo->{socket}, $sockinfo->{sockaddr})
                and next; # let EISCONN below handle this (rare) race 'hazard'

            # 'Operation now in progress' and 'Operation already in progress'
            if ($! == EINPROGRESS() || $! == EALREADY()) {
                next; # still connecting
            }

            # at this point we've either connected or failed
            delete $socks{$host};

            if ($! == EISCONN()) {
                delete $sockinfo->{sockaddr};
                $connected{$host} = $sockinfo;
            }
            else {
                warn "Unable to connect to $host: $! ".($!+0);
            }
        }

        # check termination conditions
        # XXX perhaps via a callback - for now just take the first one(s)
        last if keys %connected > $minimum;
        last if time() > $end_time;

        sleep $poll_delay;
    }

    return undef unless %connected;
    return \%connected;
}