#!/usr/bin/perl -s
use strict;
use warnings FATAL => 'all';

use Errno               qw(ETIMEDOUT EWOULDBLOCK);
use IO::Socket::Timeout qw(IO::Socket::UNIX);
use IO::Socket::UNIX;
use Sys::Hostname;

# treat uppercase variables as constants
my $SOCK_PATH   = "$ENV{HOME}/test_socket.sock";
my $SERVER_WAIT = 3;
my $CLIENT_WAIT = 4;

# program switches [see '-s' perl command line option]
our ($s,$c);
die usage() if (defined $s && defined $c)
    || (!defined $s && !defined $c);

# server:
if ($s) {
    unlink $SOCK_PATH;
    my $server = IO::Socket::UNIX->new(
        Type => SOCK_STREAM(),
        Local => $SOCK_PATH,
        Listen => 1,
        );

    my ($count,$hostname) = 1;
    while (my $conn = $server->accept()) {
        $conn->print(job($count)." Hello from ".hostname
                     ." @ ".localtime."\n");
    }
}
# client:
elsif ($c) {
    my $client = IO::Socket::UNIX->new(
        Type => SOCK_STREAM(),
        Peer => $SOCK_PATH,
        );

    # IO::Socket provides a way to set a timeout on the socket, but
    # the timeout will be used only for connection, not for reading
    # / writing operations. So we use IO::Socket::Timeout :-)
    IO::Socket::Timeout->enable_timeouts_on($client);
    $client->read_timeout($CLIENT_WAIT);

    # evaluate timeout
    my $response = <$client>;
    if (! $response && ( 0+$! == ETIMEDOUT || 0+$! == EWOULDBLOCK )) {
        die "timeout reading socket; committing seppuku";
    }
    print "server says: ". $response ."\n";
}
# unrecognised mode:
else {
    die "see usage instructions; unrecognised operating mode";
}



sub usage {
    return "\nusage: perl $0 <switch>\n\n"
        ."<Switches> - no clustering; single switch use only\n"
        ." -s : run $0 in server mode\n"
        ." -c : run $0 in client mode\n";
}

__END__
[download]