I decided to write a much simpler, single-file example for you to examine using Proc::Background. I'll start with the starting, examining, input/output and stopping, then I'll show the code.
start the daemon
$ ./script.pl start
started script.pl daemon at PID 30216
verify it's running
$ ./script.pl status
script.pl is running at PID 30216
$ ps ax | grep 30216
30216 pts/4 S 0:00 perl script.pl perform
connect to the daemon
$ telnet localhost 6669
Trying 127.0.0.1...
Connected to localhost.
Escape character is '^]'.
enter some input, and ensure the network daemon returns correctly
blah
received: blah
network daemon closes connection
Connection closed by foreign host.
ensure the daemon is still running
$ ./script.pl status
script.pl is running at PID 30216
$ ps ax | grep 30216
30216 pts/4 S 0:00 perl script.pl perform
stop the daemon
$ ./script.pl stop
stopped script.pl PID 30216
ensure it's really stopped
$ ./script.pl status
script.pl is not running
$ ps ax | grep 30216
Code. Note that although the usage printout doesn't show perform, if you run the script like ./script perform, it'll run in the foreground instead of going into the background. Note also I use $0 which holds the name of the script file, so no matter what you name the file, the output will always reflect the current script.
#!/usr/bin/perl
use warnings;
use strict;
use IO::Socket::INET;
use Proc::Background;
if (! @ARGV || $ARGV[0] !~ /(?:start|stop|status|perform)/){
die "usage: $0 <start|stop|status>\n"
}
my $op = $ARGV[0];
my $pid_file = '/tmp/proc.pid';
# this...
start() if $op eq 'start';
stop() if $op eq 'stop';
status() if $op eq 'status';
perform() if $op eq 'perform';
# could also be written in a more concise way...
#{
# no strict 'refs';
# &$op();
#}
sub start {
if (status(1)){
print "$0 already running at " ._get_pid(). "\n";
exit;
}
my $proc = Proc::Background->new("perl $0 perform");
my $pid = $proc->pid;
print "started $0 daemon at PID $pid\n";
open my $wfh, '>', $pid_file or die $!;
print $wfh $pid;
close $wfh;
}
sub stop {
my $pid;
if (status(1)){
$pid = _get_pid();
kill 'KILL', $pid;
unlink $pid_file;
print "stopped $0 PID $pid\n";
}
else {
print "$0 doesn't appear to be running\n";
}
}
sub status {
my $quiet = shift;
my $pid = _get_pid();
my $status = $pid ? 1 : 0;
if ($status){
print "$0 is running at PID $pid\n" if ! $quiet;
}
else {
print "$0 is not running\n" if ! $quiet;
}
return $status;
}
sub perform {
my $sock = new IO::Socket::INET (
LocalHost => '0.0.0.0',
LocalPort => 6669,
Proto => 'tcp',
Listen => 5,
Reuse => 1,
);
die "cannot create socket $!\n" unless $sock;
while (1){
my $conn = $sock->accept;
# below is what we receive from the client
my $recv;
$conn->recv($recv, 1024);
# ...and this is what we send back
my $send = "received: $recv\n";
$conn->send($send);
shutdown($conn, 1);
}
$sock->close;
}
sub _get_pid {
my $pid;
if (-e $pid_file){
open my $fh, '<', $pid_file or die $!;
$pid = <$fh>;
close $fh;
}
return $pid;
}
up-to-date version can be found on my github for future reference