#!/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;
}