Server::Control::NetServer - apachectl style control for Net::Server servers

    package My::Server;
    use base qw(Net::Server);
    sub process_request {
       #...code...
    }

    ---

    use Server::Control::NetServer;

    my $ctl = Server::Control::NetServer->new(
        net_server_class  => 'My::Server',
        net_server_params => {
            pid_file => '/path/to/server.pid',
            port     => 5678,
            log_file => '/path/to/file.log'
        }
    );
    if ( !$ctl->is_running() ) {
        $ctl->start(...);
    }

package Server::Control::NetServer;
BEGIN {
  $Server::Control::NetServer::VERSION = '0.15';
}
use Carp;
use Moose;
use MooseX::StrictConstructor;
use strict;
use warnings;

extends 'Server::Control';

has 'net_server_class'  => ( is => 'ro', isa => 'Str', required => 1 );
has 'net_server_params' => ( is => 'ro', isa => 'HashRef', default => sub { {} } );

# All of this hackery is to skip the port check on start during a HUP,
# because Net::Server leaves the sockets open.
#
has 'in_hup' => ( is => 'ro' );
before '_perform_cli_action' => sub {
    push( @ARGV, '--in-hup' ) if !( grep { $_ eq '--in-hup' } @ARGV );
};
around '_listening_before_start' => sub {
    my $orig = shift;
    my $self = shift;
    return $self->in_hup() ? 0 : $self->$orig(@_);
};

__PACKAGE__->meta->make_immutable();

sub _cli_option_pairs {
    my $class = shift;
    return ( $class->SUPER::_cli_option_pairs, 'in-hup' => 'in_hup', );
}

sub _build_port {
    my $self = shift;
    return $self->net_server_params->{port}
      || die "port must be passed in net_server_params";
}

sub _build_pid_file {
    my $self = shift;
    return $self->net_server_params->{pid_file}
      || die "pid_file must be passed in net_server_params";
}

sub _build_error_log {
    my $self            = shift;
    my $server_log_file = $self->net_server_params->{log_file};
    return ( defined($server_log_file) && $server_log_file ne 'Sys::Syslog' )
      ? $server_log_file
      : undef;
}

sub do_start {
    my $self = shift;

    # Fork child. Child will fork again to start server, and then exit in
    # Net::Server::post_configure. Parent continues with rest of
    # Server::Control::start() to see if the server has started correctly
    # and report status.
    #
    my $child = fork;
    croak "Can't fork: $!" unless defined($child);
    if ( !$child ) {
        Class::MOP::load_class( $self->net_server_class );
        $self->net_server_class->run(
            background => 1,
            %{ $self->net_server_params }
        );
        exit(0);    # Net::Server should exit, but just to be safe
    }
}

1;

__END__