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 - $!"; }