I did not try File::Slurper because I am not slurping a file, I'm reading data from a socket.
I don't want to suppress the warning since it is warning of a deprecation which implies it will break in the future.
There is a parent and a forked child process. The child creates a socket and starts listening for connections using IO::Select to see when the socket is read ready. The parent connects to the child's socket, sets encoding(UTF-8) and sends UTF-8 encoded XML down the socket to the child. The child sees the parents connect, accepts it enables encoding(UTF-8) on the new socket. When the child sees data, it reads it with sysread. There is a bit more to it than that but that is the essence of it.
The code is like (but not exactly) this
use 5.016;
use strict;
use warnings;
use Socket;
use IO::Socket;
use IO::Socket::INET;
use Data::Dumper;
use IO::Select;
use Errno qw(EPIPE);
my $port = '11111';
my $pid = fork;
if ($pid) {
# server
sleep 10;
my $sock1;
my $attempts = 100;
while ($attempts--) {
$sock1 = IO::Socket::INET->new (
PeerHost => 'localhost',
PeerPort => '9001',
Proto => 'tcp');
if (!$sock1) {
say "Cannot connect to child socket - $!";
sleep 2;
} else {
last;
}
}
if (!$sock1) {
say "Failed to connect after 100 attempts";
say "Killing child";
kill 'TERM', $pid;
say "waiting on child";
waitpid($pid, 0);
}
binmode($sock1, ':encoding(UTF-8)');
$sock1->send("<element>Hello</element>\r\n");
sleep 10;
my $sock2 = IO::Socket::INET->new (
PeerHost => 'localhost',
PeerPort => '9001',
Proto => 'tcp');
$sock2->send("<element>Hello2</element>\r\n");
sleep 10;
say "shutdown 1";
shutdown($sock1, 1); # stopped writing
shutdown($sock2, 1); # stopped writing
sleep 5;
say "shutdown 2";
shutdown($sock1, 2); # stopped using this socket
shutdown($sock2, 2); # stopped using this socket
sleep 5;
say "closing socket";
close($sock1);
close($sock2);
say "Killing child";
kill 'TERM', $pid;
say "waiting on child";
waitpid($pid, 0);
say "parent exiting";
exit;
} elsif (!defined $pid) {
die "fork failed with $!";
} else {
# child
say "child started";
sleep 15;
my $sock = IO::Socket::INET->new(Listen => 50,
LocalAddr => 'localhost',
LocalPort => 9001,
Proto => 'tcp',
ReuseAddr => 1);
my $select = IO::Select->new();
$select->add($sock);
my $buf = '';
while (1) {
#exit 0; uncomment to test SIGPIPE
my @ready = $select->can_read(5);
foreach my $ready (@ready) {
if ($ready == $sock) {
my $s = $sock->accept();
my $client_address = $s->peerhost();
my $client_port = $s->peerport();
say "connection from $client_address:$client_port\n";
$select->add($s);
binmode($s, ':encoding(UTF-8)');
} else {
say "Child reading socket";
my $read = sysread($ready, $buf, 1024, length($buf));
if (!defined($read)) {
say "Child sysread error - $!";
last;
} elsif ($read == 0) {
say "Child EOF";
$select->remove($ready);
close $ready;
sleep 1;
last;
} else {
while ($buf =~ s/^(.*)\r\n//) {
say "Child got /$1/";
# child does something with this
};
}
}
}
}
exit;
}
Results in
child started
Cannot connect to child socket - Connection refused
Cannot connect to child socket - Connection refused
Cannot connect to child socket - Connection refused
connection from 127.0.0.1:39310
Child reading socket
Child got /<element>Hello</element>/
connection from 127.0.0.1:39318
Child reading socket
Child got /<element>Hello2</element>/
shutdown 1
Child reading socket
Child EOF
Child reading socket
Child EOF
shutdown 2
closing socket
Killing child
waiting on child
parent exiting
|