#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket::UNIX;
use constant SOCKET => 'test_socket.sock';
my $mode = shift or die "Specify a mode\n";
if ($mode eq 'server') {
my $server = IO::Socket::UNIX->new(
Type => SOCK_STREAM,
Local => SOCKET,
Listen => 1,
) or die $!;
while (my $conn = $server->accept()) {
sleep 5;
my $name = <$conn>;
print {$conn} "Hello $name";
close $conn;
}
}
elsif ($mode eq 'client') {
my $client = IO::Socket::UNIX->new(
Type => SOCK_STREAM,
Peer => SOCKET,
Timeout => 2,
) or die $!;
print {$client} 'John', "\n";
print "Got reponse: ", scalar <$client>;
close $client;
}
else {
die "Unsupported mode: $mode\n";
}
####
my $ALARM_EXCEPTION = "alarm clock restart";
eval {
local $SIG{ALRM} = sub { die $ALARM_EXCEPTION };
alarm 10;
flock(FH, 2) # blocking write lock
|| die "cannot flock: $!";
alarm 0;
};
if ($@ && $@ !~ quotemeta($ALARM_EXCEPTION)) { die }
####
use POSIX qw[ ETIMEDOUT EWOULDBLOCK ];
use Socket qw[ SOL_SOCKET SO_RCVTIMEO ];
my $client = IO::Socket::UNIX->new(
Type => SOCK_STREAM,
Peer => SOCKET,
) or die $!;
my $timeval = pack 'l!l!,
2, # seconds
0; # microseconds
$socket->setsockopt(SOL_SOCKET, SO_RCVTIMEO, $timeval) or die $!;
print {$client} "John", "\n";
my $response = <$client>;
die 'Timeout' if !$response and $! == ETIMEDOUT || $! == EWOULDBLOCK;
...