X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FDaemonize.pm;h=ffae57707438a5bcc09a6e94ae371a91ec582422;hb=2eced27121e8557fe773f6f8804786f29f5660c1;hp=bd9c203fed1541c6fc9fba453004879eccbe26bd;hpb=a392fa535f5dff96ae83c33b17ba272db0f34b2b;p=gitmo%2FMooseX-Daemonize.git diff --git a/lib/MooseX/Daemonize.pm b/lib/MooseX/Daemonize.pm index bd9c203..ffae577 100644 --- a/lib/MooseX/Daemonize.pm +++ b/lib/MooseX/Daemonize.pm @@ -1,13 +1,14 @@ 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); @@ -22,135 +23,180 @@ has progname => ( }, ); -has pidbase => ( - isa => 'Str', +has basedir => ( + isa => 'Path::Class::Dir', is => 'ro', - lazy => 1, + coerce => 1, required => 1, - default => sub { return '/var/run' }, + lazy => 1, + default => sub { Path::Class::Dir->new('/') }, ); -has pidfile => ( - isa => 'Str', +has pidbase => ( + isa => 'Path::Class::Dir', is => 'ro', + coerce => 1, + required => 1, lazy => 1, - required => 1, - default => sub { $_[0]->pidbase . '/' . $_[0]->progname . '.pid' }, + default => sub { Path::Class::Dir->new('var', 'run') }, +); + +coerce 'MooseX::Daemonize::PidFile' + => from 'Str' + => via { MooseX::Daemonize::PidFile->new( file => $_ ) }; + +has pidfile => ( + 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 ); + }, + handles => { + check => 'running', + save_pid => 'write', + remove_pid => 'remove', + get_pid => 'pid', + }, ); has foreground => ( metaclass => 'Getopt', - cmd_aliases => ['f'], + cmd_aliases => 'f', isa => 'Bool', is => 'ro', default => sub { 0 }, ); -sub check { - my ($self) = @_; - my $pidfile = $self->pidfile; - if ( -e $pidfile ) { - my $prog = $self->progname; - chomp( my $pid = read_file($pidfile) ); - if ( kill 0 => $pid ) { - croak "$prog already running ($pid)."; - } - carp "$prog not running but $pidfile exists. Perhaps it is stale?"; - return 1; - } - return 0; -} +has is_daemon => ( + isa => 'Bool', + is => 'rw', + default => sub { 0 }, +); + +has stop_timeout => ( + isa => 'Int', + is => 'rw', + default => sub { 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; - my $pidfile = $self->pidfile; - lock( $pidfile, undef, 'nonblocking' ) - or croak "Could not lock PID file $pidfile: $!"; - write_file( $pidfile, "$$\n" ); - unlock($pidfile); + 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->setup_signals; - return; + return $$; } +# Make _kill *really* private +my $_kill; + sub stop { - my ($self) = @_; - my $pidfile = $self->pidfile; - unless ( -e $pidfile ) { - carp $self->progname . ' is not currently running.'; - return; - } - chomp( my $pid = read_file($pidfile) ); - $self->kill($pid) unless $self->foreground(); - lock( $pidfile, undef, 'nonblocking' ) - or croak "Could not lock PID file $pidfile: $!"; - unlink($pidfile); - unlock($pidfile); - return; + my ( $self, %args ) = @_; + my $pid = $self->get_pid; + $self->$_kill($pid) unless $self->foreground(); + $self->remove_pid; + return 1 if $args{no_exit}; + exit; } sub restart { my ($self) = @_; - $self->stop(); + $self->stop( no_exit => 1 ); $self->start(); } sub setup_signals { - my $self = @_; - $SIG{INT} = sub { $_[0]->handle_sigint; }; - $SIG{HUP} = sub { $_[0]->handle_sighup }; + my ($self) = @_; + $SIG{INT} = sub { $self->handle_sigint; }; + $SIG{HUP} = sub { $self->handle_sighup }; } sub handle_sigint { $_[0]->stop; } -sub handle_sighup { return; } +sub handle_sighup { $_[0]->restart; } -sub kill { +$_kill = sub { my ( $self, $pid ) = @_; - unless ( kill 0 => $pid ) { - carp "$pid already appears dead."; + return unless $pid; + unless ( CORE::kill 0 => $pid ) { + + # warn "$pid already appears dead."; return; } - kill( 2, $pid ); # Try SIGINT - sleep(1) if kill( 0, $pid ); + if ( $pid eq $$ ) { - unless ( kill 0 => $pid or $!{EPERM} ) { # IF it is still running - kill( 15, $pid ); # try SIGTERM - sleep(1) if kill( 0, $pid ); + # warn "$pid is us! Can't commit suicide."; + return; } - unless ( kill 0 => $pid or $!{EPERM} ) { # IF it is still running - kill( 9, $pid ); # finally try SIGKILL - sleep(1) if kill( 0, $pid ); - } + my $timeout = $self->stop_timeout; - unless ( kill 0 => $pid or $!{EPERM} ) { # IF it is still running - carp "$pid doesn't seem to want to die."; # AHH EVIL DEAD! + # 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--; + } } - 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 @@ -175,28 +221,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 @@ -227,25 +285,33 @@ 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 =item handle_sigint() -Handle a INT signal, by default calls C<$self->stop()>; +Handle a INT signal, by default calls C<$self->stop()> =item handle_sighup() -Handle a HUP signal. Nothing is done by default. +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 +The C method from L =back @@ -257,7 +323,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 @@ -296,10 +362,17 @@ L, L, L Chris Prather C<< >> +=head1 THANKS + +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.