X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FDaemonize.pm;h=94268b5c5bb0b3f9c20b5c11d71e2bb027d18111;hb=ea9485d8cc815a443d6bb844858156d1fdb65a42;hp=925a78635808fe85db014f336fb7371eaddd25a0;hpb=fa2b72a40f356bef1bcd64dee82cd81e56960c81;p=gitmo%2FMooseX-Daemonize.git diff --git a/lib/MooseX/Daemonize.pm b/lib/MooseX/Daemonize.pm index 925a786..94268b5 100644 --- a/lib/MooseX/Daemonize.pm +++ b/lib/MooseX/Daemonize.pm @@ -1,15 +1,20 @@ package MooseX::Daemonize; use strict; # because Kwalitee is pedantic use Moose::Role; +use MooseX::Types::Path::Class; +use Moose::Util::TypeConstraints; -our $VERSION = 0.01_1; -use Carp; -use Proc::Daemon; +our $VERSION = 0.05; -use File::Pid; -use Moose::Util::TypeConstraints; +use Carp 'carp'; +use Proc::Daemon; +use MooseX::Daemonize::PidFile; -with qw(MooseX::Getopt); +with qw[ + MooseX::Daemonize::Core + MooseX::Daemonize::SignalHandling + MooseX::Getopt +]; has progname => ( isa => 'Str', @@ -23,64 +28,67 @@ has progname => ( ); has basedir => ( - isa => 'Str', - is => 'ro', - lazy => 1, - default => sub { return '/' }, + isa => 'Path::Class::Dir', + is => 'ro', + coerce => 1, + required => 1, + lazy => 1, + default => sub { Path::Class::Dir->new('/') }, ); has pidbase => ( - isa => 'Str', - is => 'ro', - - # required => 1, - lazy => 1, - default => sub { return '/var/run' }, + isa => 'Path::Class::Dir', + is => 'ro', + coerce => 1, + required => 1, + lazy => 1, + default => sub { Path::Class::Dir->new('var', 'run') }, ); -subtype 'Pidfile' => as 'Object' => where { $_->isa('File::Pid') }; -coerce 'Pidfile' => from 'Str' => via { - File::Pid->new( { file => $_, } ); -}; +coerce 'MooseX::Daemonize::PidFile' + => from 'Str' + => via { MooseX::Daemonize::PidFile->new( file => $_ ) }; has pidfile => ( - isa => 'Pidfile', - is => 'ro', - lazy => 1, - required => 1, - coerce => 1, - default => sub { - die 'Cannot write to ' . $_[0]->pidbase unless -w $_[0]->pidbase; + isa => 'MooseX::Daemonize::PidFile', + is => 'rw', + lazy => 1, + required => 1, + coerce => 1, + predicate => 'has_pidfile', + default => sub { my $file = $_[0]->pidbase . '/' . $_[0]->progname . '.pid'; - File::Pid->new( { file => $file } ); - }, - handles => { - check => 'running', - save_pid => 'write', - remove_pid => 'remove', - get_pid => 'pid', + confess "Cannot write to $file" unless (-e $file ? -w $file : -w $_[0]->pidbase); + MooseX::Daemonize::PidFile->new( file => $file ); }, ); has foreground => ( metaclass => 'Getopt', - cmd_aliases => ['f'], + cmd_aliases => 'f', isa => 'Bool', is => 'ro', default => sub { 0 }, ); -sub daemonize { - my ($self) = @_; - Proc::Daemon::Init; -} + +has stop_timeout => ( + isa => 'Int', + is => 'rw', + default => sub { 2 } +); sub start { my ($self) = @_; - return if $self->check; - + + confess "instance already running" if $self->pidfile->running; + $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' ); @@ -90,16 +98,19 @@ sub start { # Change to basedir chdir $self->basedir; - $self->save_pid; + $self->pidfile->write; $self->setup_signals; return $$; } +# Make _kill *really* private +my $_kill; + sub stop { my ( $self, %args ) = @_; - my $pid = $self->get_pid; - $self->_kill($pid) unless $self->foreground(); - $self->remove_pid; + my $pid = $self->pidfile->pid; + $self->$_kill($pid) unless $self->foreground(); + $self->pidfile->remove; return 1 if $args{no_exit}; exit; } @@ -110,17 +121,16 @@ sub restart { $self->start(); } -sub setup_signals { - my ($self) = @_; - $SIG{INT} = sub { $self->handle_sigint; }; - $SIG{HUP} = sub { $self->handle_sighup }; +sub handle_signal { + my ($self, $signal) = @_; + return $self->handle_sigint if $signal eq 'INT'; + return $self->handle_sighup if $signal eq 'HUP'; } 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 ) { @@ -131,42 +141,48 @@ sub _kill { 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 ); - - 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 ); + 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! + for ( [ 2, $timeout ], [15, $timeout], [9, $timeout * 1.5] ) { + my ($signal, $timeout) = @$_; + $timeout = int $timeout; + + 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--; + } } - 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 ); - } - - unless ( CORE::kill 0 => $pid or $!{EPERM} ) { # IF it is still running - carp "$pid doesn't seem to want to die."; # AHH EVIL DEAD! - } + return unless ( CORE::kill 0 => $pid or $!{EPERM} ); - return; -} + # 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 @@ -191,28 +207,40 @@ This document describes MooseX::Daemonize version 0.0.1 =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 =over -=item progname Str +=item progname Path::Class::Dir | Str -The name of our daemon, defaults to $0 +The name of our daemon, defaults to $self->meta->name =~ s/::/_/; -=item pidbase Str +=item pidbase Path::Class::Dir | Str The base for our bid, defaults to /var/run/$progname -=item pidfile Str +=item pidfile MooseX::Daemonize::PidFile | Str -The file we store our PID in, defaults to /var/run/$progname/ +The file we store our PID in, defaults to /var/run/$progname =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 @@ -220,10 +248,6 @@ If true, the process won't background. Useful for debugging. This option can be =over -=item check() - -Check to see if an instance is already running. - =item start() Setup a pidfile, fork, then setup the signal handlers. @@ -243,10 +267,6 @@ Litterally Calls C 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 @@ -259,18 +279,6 @@ Handle a INT signal, by default calls C<$self->stop()> Handle a HUP signal. By default calls C<$self->restart()> -=item get_pid - -Lookup the pid from our pidfile. - -=item save_pid - -Save the current pid in our pidfile - -=item remove_pid - -Delete our pidfile - =item meta() The C method from L @@ -285,7 +293,7 @@ The C method from L the module is part of the standard Perl distribution, part of the module's distribution, or must be installed separately. ] -Obviously L, also L, L, L +Obviously L, and L =head1 INCOMPATIBILITIES @@ -326,11 +334,15 @@ Chris Prather C<< >> =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 + +Some bug fixes sponsored by Takkle Inc. =head1 LICENCE AND COPYRIGHT -Copyright (c) 2007, Chris Prather C<< >>. All rights reserved. +Copyright (c) 2007, Chris Prather C<< >>. 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.