MooseX::Daemonize - Role for daemonizing your Moose based application

    package My::Daemon;
    use Moose;

    with qw(MooseX::Daemonize);

    # ... define your class ....

    after start => sub {
        my $self = shift;
        return unless $self->is_daemon;
        # your daemon code here ...
    };

    # then in your script ...

    my $daemon = My::Daemon->new_with_options();

    my ($command) = @{$daemon->extra_argv}
    defined $command || die "No command specified";

    $daemon->start   if $command eq 'start';
    $daemon->status  if $command eq 'status';
    $daemon->restart if $command eq 'restart';
    $daemon->stop    if $command eq 'stop';

    warn($daemon->status_message);
    exit($daemon->exit_code);

package MooseX::Daemonize;
use strict;    # because Kwalitee is pedantic
use Moose::Role;
use MooseX::Types::Path::Class;

our $VERSION   = '0.12';

with 'MooseX::Daemonize::WithPidFile',
     'MooseX::Getopt';

sub OK    () { 0 }
sub ERROR () { 1 }

has progname => (
    metaclass => 'Getopt',
    isa       => 'Str',
    is        => 'ro',
    lazy      => 1,
    required  => 1,
    default   => sub {
        ( my $name = lc $_[0]->meta->name ) =~ s/::/_/g;
        return $name;
    },
);

has pidbase => (
    metaclass => 'Getopt',
    isa       => 'Path::Class::Dir',
    is        => 'ro',
    coerce    => 1,
    required  => 1,
    lazy      => 1,
    default   => sub { Path::Class::Dir->new('', 'var', 'run') },
);

has basedir => (
    metaclass => 'Getopt',
    isa       => 'Path::Class::Dir',
    is        => 'ro',
    coerce    => 1,
    required  => 1,
    lazy      => 1,
    default   => sub { Path::Class::Dir->new('/') },
);

has foreground => (
    metaclass   => 'Getopt',
    cmd_aliases => 'f',
    isa         => 'Bool',
    is          => 'ro',
    default     => sub { 0 },
);

has stop_timeout => (
    metaclass => 'Getopt',
    isa       => 'Int',
    is        => 'rw',
    default   => sub { 2 }
);

# internal book-keeping

has status_message => (
    metaclass => 'NoGetopt',
    isa       => 'Str',
    is        => 'rw',
    clearer   => 'clear_status_message',
);

has exit_code => (
    metaclass => 'NoGetopt',
    isa       => 'Int',
    is        => 'rw',
    clearer   => 'clear_exit_code',
);

# methods ...

## PID file related stuff ...

sub init_pidfile {
    my $self = shift;
    my $file = $self->pidbase . '/' . $self->progname . '.pid';
    confess "Cannot write to $file" unless (-e $file ? -w $file : -w $self->pidbase);
    MooseX::Daemonize::Pid::File->new( file => $file );
}

# backwards compat,
sub check      { (shift)->pidfile->is_running }
sub save_pid   { (shift)->pidfile->write      }
sub remove_pid { (shift)->pidfile->remove     }
sub get_pid    { (shift)->pidfile->pid        }

## signal handling ...

sub setup_signals {
    my $self = shift;
    $SIG{'INT'} = sub { $self->shutdown };
# I can't think of a sane default here really ...
#    $SIG{'HUP'} = sub { $self->handle_sighup };
}

sub shutdown {
    my $self = shift;
    $self->pidfile->remove if $self->pidfile->pid == $$;
    exit(0);
}

## daemon control methods ...

sub start {
    my $self = shift;

    $self->clear_status_message;
    $self->clear_exit_code;

    if ($self->pidfile->is_running) {
        $self->exit_code($self->OK);
        $self->status_message('Daemon is already running with pid (' . $self->pidfile->pid . ')');
        return !($self->exit_code);
    }

    if ($self->foreground) {
        $self->is_daemon(1);
    }
    else {
        eval { $self->daemonize };
        if ($@) {
            $self->exit_code($self->ERROR);
            $self->status_message('Start failed : ' . $@);
            return !($self->exit_code);
        }
    }

    unless ($self->is_daemon) {
        $self->exit_code($self->OK);
        $self->status_message('Start succeeded');
        return !($self->exit_code);
    }

    $self->pidfile->pid($$);

    # Change to basedir
    chdir $self->basedir;

    $self->pidfile->write;
    $self->setup_signals;
    return $$;
}

sub status {
    my $self = shift;

    $self->clear_status_message;
    $self->clear_exit_code;

    if ($self->pidfile->is_running) {
        $self->exit_code($self->OK);
        $self->status_message('Daemon is running with pid (' . $self->pidfile->pid . ')');
    }
    else {
        $self->exit_code($self->ERROR);
        $self->status_message('Daemon is not running with pid (' . $self->pidfile->pid . ')');
    }

    return !($self->exit_code);
}

sub restart {
    my $self = shift;

    $self->clear_status_message;
    $self->clear_exit_code;

    unless ($self->stop) {
        $self->exit_code($self->ERROR);
        $self->status_message('Restart (Stop) failed : ' . $@);
    }

    unless ($self->start) {
        $self->exit_code($self->ERROR);
        $self->status_message('Restart (Start) failed : ' . $@);
    }

    if ($self->exit_code == $self->OK) {
        $self->exit_code($self->OK);
        $self->status_message("Restart successful");
    }

    return !($self->exit_code);
}

# Make _kill *really* private
my $_kill;

sub stop {
    my $self = shift;

    $self->clear_status_message;
    $self->clear_exit_code;

    # if the pid is not running
    # then we dont need to stop
    # anything ...
    if ($self->pidfile->is_running) {

        # if we are foreground, then
        # no need to try and kill
        # ourselves
        unless ($self->foreground) {

            # kill the process ...
            eval { $self->$_kill($self->pidfile->pid) };
            # and complain if we can't ...
            if ($@) {
                $self->exit_code($self->ERROR);
                $self->status_message('Stop failed : ' . $@);
            }
            # or gloat if we succeed ..
            else {
                $self->exit_code($self->OK);
                $self->status_message('Stop succeeded');
            }

        }
    }
    else {
        # this just returns the OK
        # exit code for now, but
        # we should make this overridable
        $self->exit_code($self->OK);
        $self->status_message("Not running");
    }

    # if we are returning to our script
    # then we actually need the opposite
    # of what the system/OS expects
    return !($self->exit_code);
}

$_kill = sub {
    my ( $self, $pid ) = @_;
    return unless $pid;
    unless ( CORE::kill 0 => $pid ) {
        # warn "$pid already appears dead.";
        return;
    }

    if ( $pid eq $$ ) {
        die "$pid is us! Can't commit suicide.";
    }

    my $timeout = $self->stop_timeout;

    # kill 0 => $pid returns 0 if the process is dead
    # $!{EPERM} could also be true if we cant kill it (permission error)

    # Try SIGINT ... 2s ... SIGTERM ... 2s ... SIGKILL ... 3s ... UNDEAD!
    my $terminating_signal;
    for ( [ 2, $timeout ], [15, $timeout], [9, $timeout * 1.5] ) {
        my ($signal, $timeout) = @$_;
        $timeout = int $timeout;

        CORE::kill($signal, $pid);

        while ($timeout) {
            unless(CORE::kill 0 => $pid or $!{EPERM}) {
                $terminating_signal = $signal;
                last;
            }
            $timeout--;
            sleep(1) if $timeout;
        }

        last if $terminating_signal;
    }

    if($terminating_signal) {
        if($terminating_signal == 9) {
            # clean up the pidfile ourselves iff we used -9 and it worked
            warn "Had to resort to 'kill -9' and it worked, wiping pidfile";
            eval { $self->pidfile->remove };
            if ($@) {
                warn "Could not remove pidfile ("
                   . $self->pidfile->file
                   . ") because : $!";
            }
        }
        return;
    }

    # IF it is still running
    Carp::carp "$pid doesn't seem to want to die.";     # AHH EVIL DEAD!
};

1;
__END__