X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FDaemonize.pm;h=ba46d4db36b4351604bee1c822a5c56248501b5a;hb=b38ab84f7a1b83212eefcb2e7f876c42b8dbfb24;hp=925a78635808fe85db014f336fb7371eaddd25a0;hpb=fa2b72a40f356bef1bcd64dee82cd81e56960c81;p=gitmo%2FMooseX-Daemonize.git diff --git a/lib/MooseX/Daemonize.pm b/lib/MooseX/Daemonize.pm index 925a786..ba46d4d 100644 --- a/lib/MooseX/Daemonize.pm +++ b/lib/MooseX/Daemonize.pm @@ -1,275 +1,484 @@ package MooseX::Daemonize; use strict; # because Kwalitee is pedantic use Moose::Role; +use MooseX::Types::Path::Class; -our $VERSION = 0.01_1; -use Carp; -use Proc::Daemon; +our $VERSION = 0.06; -use File::Pid; -use Moose::Util::TypeConstraints; - -with qw(MooseX::Getopt); +with 'MooseX::Daemonize::WithPidFile', + 'MooseX::Getopt'; + +use constant OK => 0; +use constant ERROR => 1; has progname => ( - isa => 'Str', - is => 'ro', - lazy => 1, - required => 1, - default => sub { + metaclass => 'Getopt', + isa => 'Str', + is => 'ro', + lazy => 1, + required => 1, + default => sub { ( my $name = lc $_[0]->meta->name ) =~ s/::/_/g; return $name; }, ); -has basedir => ( - isa => 'Str', - is => 'ro', - lazy => 1, - default => sub { return '/' }, -); - has pidbase => ( - isa => 'Str', - is => 'ro', - - # required => 1, - lazy => 1, - default => sub { return '/var/run' }, + metaclass => 'Getopt', + 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 => $_, } ); -}; - -has pidfile => ( - isa => 'Pidfile', - is => 'ro', - lazy => 1, - required => 1, - coerce => 1, - default => sub { - die 'Cannot write to ' . $_[0]->pidbase unless -w $_[0]->pidbase; - my $file = $_[0]->pidbase . '/' . $_[0]->progname . '.pid'; - File::Pid->new( { file => $file } ); - }, - handles => { - check => 'running', - save_pid => 'write', - remove_pid => 'remove', - get_pid => 'pid', - }, +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'], + cmd_aliases => 'f', isa => 'Bool', is => 'ro', default => sub { 0 }, ); -sub daemonize { - my ($self) = @_; - Proc::Daemon::Init; +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) = @_; - return if $self->check; + my $self = shift; + + $self->clear_status_message; + $self->clear_exit_code; + + if ($self->pidfile->is_running) { + $self->exit_code(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(ERROR); + $self->status_message('Start failed : ' . $@); + return !($self->exit_code); + } + } - $self->daemonize unless $self->foreground; + unless ($self->is_daemon) { + $self->exit_code(OK); + $self->status_message('Start succeeded'); + return !($self->exit_code); + } - # Avoid 'stdin reopened for output' warning with newer perls - ## no critic - open( NULL, '/dev/null' ); - if (0); - ## use critic + $self->pidfile->pid($$); # Change to basedir chdir $self->basedir; - $self->save_pid; + $self->pidfile->write; $self->setup_signals; return $$; } -sub stop { - 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 status { + my $self = shift; + + $self->clear_status_message; + $self->clear_exit_code; + + if ($self->pidfile->is_running) { + $self->exit_code(OK); + $self->status_message('Daemon is running with pid (' . $self->pidfile->pid . ')'); + } + else { + $self->exit_code(ERROR); + $self->status_message('Daemon is not running with pid (' . $self->pidfile->pid . ')'); + } + + return !($self->exit_code); } sub restart { - my ($self) = @_; - $self->stop( no_exit => 1 ); - $self->start(); -} + my $self = shift; -sub setup_signals { - my ($self) = @_; - $SIG{INT} = sub { $self->handle_sigint; }; - $SIG{HUP} = sub { $self->handle_sighup }; + $self->clear_status_message; + $self->clear_exit_code; + + unless ($self->stop) { + $self->exit_code(ERROR); + $self->status_message('Restart (Stop) failed : ' . $@); + } + + unless ($self->start) { + $self->exit_code(ERROR); + $self->status_message('Restart (Start) failed : ' . $@); + } + + if ($self->exit_code == OK) { + $self->exit_code(OK); + $self->status_message("Restart successful"); + } + + return !($self->exit_code); } -sub handle_sigint { $_[0]->stop; } -sub handle_sighup { $_[0]->restart; } +# Make _kill *really* private +my $_kill; -sub _kill { - confess "_kill isn't public" unless caller eq __PACKAGE__; +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(ERROR); + $self->status_message('Stop failed : ' . $@); + } + # or gloat if we succeed .. + else { + $self->exit_code(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(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 $$ ) { - - # warn "$pid is us! Can't commit suicied."; - return; + die "$pid is us! Can't commit suicide."; } - 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) + + # 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; + } - 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 ); + last if $terminating_signal; } - unless ( CORE::kill 0 => $pid or $!{EPERM} ) { # IF it is still running - carp "$pid doesn't seem to want to die."; # AHH EVIL DEAD! + 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; } - return; -} + # IF it is still running + Carp::carp "$pid doesn't seem to want to die."; # AHH EVIL DEAD! +}; 1; __END__ -=head1 NAME +=pod -MooseX::Daemonize - provides a Role that daemonizes your Moose based application. +=head1 NAME +MooseX::Daemonize - Role for daemonizing your Moose based application =head1 VERSION -This document describes MooseX::Daemonize version 0.0.1 - +This document describes MooseX::Daemonize version 0.05 =head1 SYNOPSIS - package FileMaker; + package My::Daemon; use Moose; + with qw(MooseX::Daemonize); - sub create_file { - my ( $self, $file ) = @_; - open( FILE, ">$file" ) || die; - close(FILE); - } + # ... define your class .... - no Moose; + 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); - # then in the main package ... - - my $daemon = FileMaker->new(); - $daemon->start(); - $daemon->create_file($file); - $daemon->stop(); - =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 provides a set of basic roles as an +infrastructure to do that. =head1 ATTRIBUTES +This list includes attributes brought in from other roles as well +we include them here for ease of documentation. All of these attributes +are settable though L's command line handling, with the +exception of C. + =over -=item progname Str +=item I + +The name of our daemon, defaults to C<$package_name =~ s/::/_/>; + +=item I + +The base for our bid, defaults to C -The name of our daemon, defaults to $0 +=item I -=item pidbase Str +The file we store our PID in, defaults to C -The base for our bid, defaults to /var/run/$progname +=item I -=item pidfile Str +If true, the process won't background. Useful for debugging. This option can +be set via Getopt's -f. -The file we store our PID in, defaults to /var/run/$progname/ +=item I -=item foreground Bool +If true, the process is the backgrounded daemon process, if false it is the +parent process. This is useful for example in an C sub { }> +block. -If true, the process won't background. Useful for debugging. This option can be set via Getopt's -f. +B This option is explicitly B available through L. + +=item I + +Number of seconds to wait for the process to stop, before trying harder to kill +it. Defaults to 2 seconds. =back -=head1 METHODS +These are the internal attributes, which are not available through MooseX::Getopt. -=over +=over 4 + +=item I + +=item I + +=back -=item check() +=head1 METHODS -Check to see if an instance is already running. +=head2 Daemon Control Methods -=item start() +These methods can be used to control the daemon behavior. Every effort +has been made to have these methods DWIM (Do What I Mean), so that you +can focus on just writing the code for your daemon. + +Extending these methods is best done with the L method modifiers, +such as C, C and C. + +=over 4 + +=item B Setup a pidfile, fork, then setup the signal handlers. -=item stop() +=item B Stop the process matching the pidfile, and unlinks the pidfile. -=item restart() +=item B -Litterally +Literally this is: $self->stop(); $self->start(); -=item daemonize() +=item B + +=item B -Calls C to daemonize this process. +=back -=item kill($pid) -Kills the process for $pid. This will try SIGINT, and SIGTERM before falling back to SIGKILL and finally giving up. +=head2 Pidfile Handling Methods -=item setup_signals() +=over 4 -Setup the signal handlers, by default it only sets up handlers for SIGINT and SIGHUP +=item B -=item handle_sigint() +This method will create a L object and tell +it to store the PID in the file C<$pidbase/$progname.pid>. -Handle a INT signal, by default calls C<$self->stop()> +=item B -=item handle_sighup() +This checks to see if the daemon process is currently running by checking +the pidfile. -Handle a HUP signal. By default calls C<$self->restart()> +=item B + +Returns the PID of the daemon process. + +=item B + +Write the pidfile. + +=item B + +Removes the pidfile. + +=back + +=head2 Signal Handling Methods -=item get_pid +=over 4 -Lookup the pid from our pidfile. +=item B -=item save_pid +Setup the signal handlers, by default it only sets up handlers for SIGINT and +SIGHUP. If you wish to add more signals just use the C method modifier +and add them. -Save the current pid in our pidfile +=item B -=item remove_pid +Handle a INT signal, by default calls C<$self->stop()> + +=item B + +Handle a HUP signal. By default calls C<$self->restart()> -Delete our pidfile +=back + +=head2 Introspection + +=over 4 =item meta() @@ -279,37 +488,14 @@ The C method from L =head1 DEPENDENCIES -=for author to fill in: - A list of all the other modules that this module relies upon, - including any restrictions on versions, and an indication whether - 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, L, L and L =head1 INCOMPATIBILITIES -=for author to fill in: - A list of any modules that this module cannot be used in conjunction - with. This may be due to name conflicts in the interface, or - competition for system or program resources, or due to internal - limitations of Perl (for example, many modules that use source code - filters are mutually incompatible). - -None reported. - +None reported. Although obviously this will not work on Windows. =head1 BUGS AND LIMITATIONS -=for author to fill in: - A list of known problems with the module, together with some - indication Whether they are likely to be fixed in an upcoming - release. Also a list of restrictions on the features the module - does provide: data types that cannot be handled, performance issues - and the circumstances in which they may arise, practical - limitations on the size of data sets, special cases that are not - (yet) handled, etc. - No bugs have been reported. Please report any bugs or feature requests to @@ -318,24 +504,29 @@ L. =head1 SEE ALSO -L, L, L +L, L -=head1 AUTHOR +=head1 AUTHORS Chris Prather C<< >> +Stevan Little 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. - =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY @@ -358,3 +549,5 @@ RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. + +=cut