X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FDaemonize.pm;h=94268b5c5bb0b3f9c20b5c11d71e2bb027d18111;hb=ea9485d8cc815a443d6bb844858156d1fdb65a42;hp=920b16e9cde8e68126dd84b4baede090a318b338;hpb=7ada91b857533205dd44d74f9686232ac7adf34f;p=gitmo%2FMooseX-Daemonize.git diff --git a/lib/MooseX/Daemonize.pm b/lib/MooseX/Daemonize.pm index 920b16e..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; -use Carp; -use Proc::Daemon; +our $VERSION = 0.05; -use File::Flock; -use File::Slurp; +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,112 +28,89 @@ 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') }, ); +coerce 'MooseX::Daemonize::PidFile' + => from 'Str' + => via { MooseX::Daemonize::PidFile->new( file => $_ ) }; + 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'; + isa => 'MooseX::Daemonize::PidFile', + is => 'rw', + lazy => 1, + required => 1, + coerce => 1, + predicate => 'has_pidfile', + default => sub { + my $file = $_[0]->pidbase . '/' . $_[0]->progname . '.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 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; -} -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' ); if (0); ## use critic - + # Change to basedir chdir $self->basedir; - - $self->save_pid; + + $self->pidfile->write; $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->remove_pid; + my $pid = $self->pidfile->pid; + $self->$_kill($pid) unless $self->foreground(); + $self->pidfile->remove; return 1 if $args{no_exit}; exit; } @@ -139,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 ) { @@ -160,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 ); - } - - 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 ); + 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 - 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 @@ -220,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 @@ -249,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. @@ -272,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 @@ -288,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 @@ -314,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, L +Obviously L, and L =head1 INCOMPATIBILITIES @@ -355,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.