use strict; # because Kwalitee is pedantic
use Moose::Role;
-our $VERSION = 0.01;
+our $VERSION = 0.04;
use Carp;
use Proc::Daemon;
-use File::Flock;
-use File::Slurp;
+use File::Pid;
+use Moose::Util::TypeConstraints;
with qw(MooseX::Getopt);
);
has basedir => (
- isa => 'Str',
- is => 'ro',
- lazy => 1,
- default => sub { return '/' },
+ isa => 'Str',
+ is => 'ro',
+ required => 1,
+ lazy => 1,
+ default => sub { return '/' },
);
has pidbase => (
- isa => 'Str',
- is => 'ro',
-
- # required => 1,
- lazy => 1,
- default => sub { return '/var/run' },
-);
-
-has pidfile => (
isa => 'Str',
is => 'ro',
lazy => 1,
required => 1,
- default => sub {
- die 'Cannot write to ' . $_[0]->pidbase unless -w $_[0]->pidbase;
- $_[0]->pidbase . '/' . $_[0]->progname . '.pid';
+ default => sub { return '/var/run' },
+);
+
+subtype 'Pidfile' => as 'Object' => where { $_->isa('File::Pid') };
+
+coerce 'Pidfile' => from 'Str' => via { File::Pid->new( { file => $_, } ); };
+
+has pidfile => (
+ isa => 'Pidfile',
+ is => 'rw',
+ lazy => 1,
+ required => 1,
+ coerce => 1,
+ predicate => 'has_pidfile',
+ default => sub {
+ my $file = $_[0]->pidbase . '/' . $_[0]->progname . '.pid';
+ die "Cannot write to $file" unless (-e $file ? -w $file : -w $_[0]->pidbase);
+ File::Pid->new( { file => $file } );
+ },
+ handles => {
+ check => 'running',
+ save_pid => 'write',
+ remove_pid => 'remove',
+ get_pid => 'pid',
+ _pidfile => 'file',
},
);
has foreground => (
- metaclass => 'Getopt',
- cmd_aliases => ['f'],
+ metaclass => 'MooseX::Getopt::Meta::Attribute',
+ cmd_aliases => 'f',
isa => 'Bool',
is => 'ro',
default => sub { 0 },
);
-sub check {
- my ($self) = @_;
- if ( my $pid = $self->get_pid ) {
- my $prog = $self->progname;
- if ( CORE::kill 0 => $pid ) {
- croak "$prog already running ($pid).";
- }
- carp "$prog not running but found pid ($pid)."
- . "Perhaps the pid file (@{ [$self->pidfile] }) is stale?";
- return 1;
- }
- return 0;
-}
+has is_daemon => (
+ isa => 'Bool',
+ is => 'rw',
+ default => sub { 0 },
+);
+
+has stop_timeout => (
+ isa => 'Int',
+ is => 'rw',
+ default => 2
+);
sub daemonize {
my ($self) = @_;
+ return if Proc::Daemon::Fork;
Proc::Daemon::Init;
+ $self->is_daemon(1);
}
sub start {
my ($self) = @_;
- return if $self->check;
-
+ confess "instance already running" if $self->check;
$self->daemonize unless $self->foreground;
+ return unless $self->is_daemon;
+
+ $self->pidfile->pid($$);
+
# Avoid 'stdin reopened for output' warning with newer perls
## no critic
open( NULL, '/dev/null' );
<NULL> if (0);
## use critic
-
+
# Change to basedir
chdir $self->basedir;
-
+
$self->save_pid;
$self->setup_signals;
return $$;
}
-sub save_pid {
- my ($self) = @_;
- my $pidfile = $self->pidfile;
- lock( $pidfile, undef, 'nonblocking' )
- or croak "Could not lock PID file $pidfile: $!";
- write_file( $pidfile, "$$\n" );
- unlock($pidfile);
- return;
-}
-
-sub remove_pid {
- my ($self) = @_;
- my $pidfile = $self->pidfile;
- lock( $pidfile, undef, 'nonblocking' )
- or croak "Could not lock PID file $pidfile: $!";
- unlink($pidfile);
- unlock($pidfile);
- return;
-}
-
-sub get_pid {
- my ($self) = @_;
- my $pidfile = $self->pidfile;
- return unless -e $pidfile;
- chomp( my $pid = read_file($pidfile) );
- return $pid;
-}
+# Make _kill *really* private
+my $_kill;
sub stop {
my ( $self, %args ) = @_;
my $pid = $self->get_pid;
- $self->_kill($pid) unless $self->foreground();
+ $self->$_kill($pid) unless $self->foreground();
$self->remove_pid;
return 1 if $args{no_exit};
exit;
sub handle_sigint { $_[0]->stop; }
sub handle_sighup { $_[0]->restart; }
-sub _kill {
- confess "_kill isn't public" unless caller eq __PACKAGE__;
+$_kill = sub {
my ( $self, $pid ) = @_;
return unless $pid;
unless ( CORE::kill 0 => $pid ) {
if ( $pid eq $$ ) {
- # warn "$pid is us! Can't commit suicied.";
+ # warn "$pid is us! Can't commit suicide.";
return;
}
- CORE::kill( 2, $pid ); # Try SIGINT
- sleep(2) if CORE::kill( 0, $pid );
+ my $timeout = $self->stop_timeout;
- unless ( CORE::kill 0 => $pid or $!{EPERM} ) { # IF it is still running
- CORE::kill( 15, $pid ); # try SIGTERM
- sleep(2) if CORE::kill( 0, $pid );
- }
+ # kill 0 => $pid returns 0 if the process is dead
+ # $!{EPERM} could also be true if we cant kill it (permission error)
- unless ( CORE::kill 0 => $pid or $!{EPERM} ) { # IF it is still running
- CORE::kill( 9, $pid ); # finally try SIGKILL
- sleep(3) if CORE::kill( 0, $pid );
- }
+ # Try SIGINT ... 2s ... SIGTERM ... 2s ... SIGKILL ... 3s ... UNDEAD!
+ for ( [ 2, $timeout ], [15, $timeout], [9, $timeout * 1.5] ) {
+ my ($signal, $timeout) = @$_;
+ $timeout = int $timeout;
- unless ( CORE::kill 0 => $pid or $!{EPERM} ) { # IF it is still running
- carp "$pid doesn't seem to want to die."; # AHH EVIL DEAD!
+ CORE::kill($signal, $pid);
+
+ last unless CORE::kill 0 => $pid or $!{EPERM};
+
+ while ($timeout) {
+ sleep(1);
+ last unless CORE::kill 0 => $pid or $!{EPERM};
+ $timeout--;
+ }
}
- return;
-}
+ return unless ( CORE::kill 0 => $pid or $!{EPERM} );
+
+ # IF it is still running
+ carp "$pid doesn't seem to want to die."; # AHH EVIL DEAD!
+};
1;
__END__
=head1 NAME
-MooseX::Daemonize - provides a Role that daemonizes your Moose based application.
-
+MooseX::Daemonize - provides a Role that daemonizes your Moose based
+application.
=head1 VERSION
-This document describes MooseX::Daemonize version 0.0.1
-
+This document describes MooseX::Daemonize version 0.04
=head1 SYNOPSIS
=head1 DESCRIPTION
-Often you want to write a persistant daemon that has a pid file, and responds appropriately to Signals.
-This module helps provide the basic infrastructure to do that.
+Often you want to write a persistant daemon that has a pid file, and responds
+appropriately to Signals. This module helps provide the basic infrastructure
+to do that.
=head1 ATTRIBUTES
=item progname Str
-The name of our daemon, defaults to $0
+The name of our daemon, defaults to $self->meta->name =~ s/::/_/;
=item pidbase Str
=item foreground Bool
-If true, the process won't background. Useful for debugging. This option can be set via Getopt's -f.
+If true, the process won't background. Useful for debugging. This option can
+be set via Getopt's -f.
+
+=item is_daemon Bool
+
+If true, the process is the backgrounded process. This is useful for example
+in an after 'start' => sub { } block
+
+=item stop_timeout
+
+Number of seconds to wait for the process to stop, before trying harder to kill
+it. Defaults to 2 seconds
=back
Calls C<Proc::Daemon::Init> to daemonize this process.
-=item kill($pid)
-
-Kills the process for $pid. This will try SIGINT, and SIGTERM before falling back to SIGKILL and finally giving up.
-
=item setup_signals()
Setup the signal handlers, by default it only sets up handlers for SIGINT and SIGHUP
the module is part of the standard Perl distribution, part of the
module's distribution, or must be installed separately. ]
-Obviously L<Moose>, also L<Carp>, L<Proc::Daemon>, L<File::Flock>, L<File::Slurp>
+Obviously L<Moose>, also L<Carp>, L<Proc::Daemon>, L<File::Pid>
=head1 INCOMPATIBILITIES
=head1 THANKS
-Mike Boyko, Matt S. Trout, Stevan Little, Brandon Black, and the #moose denzians
+Mike Boyko, Matt S. Trout, Stevan Little, Brandon Black, Ash Berlin and the
+#moose denzians
=head1 LICENCE AND COPYRIGHT
-Copyright (c) 2007, Chris Prather C<< <perigrin@cpan.org> >>. All rights reserved.
+Copyright (c) 2007, Chris Prather C<< <perigrin@cpan.org> >>. All rights
+reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.