pipe($child_reader, $child_writer);
binmode($child_reader, ":encoding(UTF-8)");
binmode($child_writer, ":encoding(UTF-8)");
$child_reader->autoflush(1);
$child_writer->autoflush(1);
# fork child
my $pid = fork;
if (!defined($pid)) {
warn "Failed to fork child process - turning off --fork_writer";
return;
}
if ($pid) { # parent
close $child_reader or warn "Parent: failed to close pipe reader - $!";
return;
} else { # child
close $child_writer or warn "Child: failed to close pipe writer - $!";
child_writer();
exit;
}
####
my $select = IO::Select->new();
$select->add(fileno $child_reader);
$last_heartbeat_sent = gmtime(0);
my $buf = '';
PROCESS:
while (1) {
my @ready = $select->can_read(5);
if (scalar(@ready)) {
my $read = sysread($child_reader, $buf, 64*1024, length($buf));
if (!defined($read)) {
warn "Failed read on pipe to parent - $!";
last PROCESS;
} elsif ($read == 0) { # EOF
warn "EOF on pipe to parent";
last PROCESS;
} else {
while ($buf =~ s/^(.*)\r\n//) {
send_message($1); # send msg down socket to server
}
}
} else {
my $now = gmtime;
if (($now - $last_heartbeat_sent) > 25) {
send_message("\r\n");
$last_heartbeat_sent = $now;
}
}
}
##
##
# $msg is the message to send, it is guaranteed < PIPE_BUF and ends in \r\n
my $sigpipe = 0;
local $SIG{PIPE} = sub {
$sigpipe = 1;
};
my $sent = print $child_writer $msg;
if (!$sent && ($!{EPIPE} || $sigpipe)) {
warn "Write to child_writer failed with EPIPE - child died ($sigpipe)");
# restarts child writer
} else {
warn "Write to child_writer failed - $!";
}