X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FDaemonize.pm;h=cb3d2498afa2af761bb20f18b9320a6c1419b47f;hb=b916501e3239371f7c4b70e9657ccb97c8ff7c03;hp=c02346f39a9f3042cf39e2dde2867c74937a1313;hpb=24a6a660ca5395d9250344164f7330e1e7709fef;p=gitmo%2FMooseX-Daemonize.git diff --git a/lib/MooseX/Daemonize.pm b/lib/MooseX/Daemonize.pm index c02346f..cb3d249 100644 --- a/lib/MooseX/Daemonize.pm +++ b/lib/MooseX/Daemonize.pm @@ -2,12 +2,12 @@ package MooseX::Daemonize; 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); @@ -23,111 +23,103 @@ has progname => ( ); 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' ); 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; @@ -135,7 +127,7 @@ sub stop { sub restart { my ($self) = @_; - $self->stop( noexit => 1 ); + $self->stop( no_exit => 1 ); $self->start(); } @@ -148,7 +140,7 @@ sub setup_signals { sub handle_sigint { $_[0]->stop; } sub handle_sighup { $_[0]->restart; } -sub kill { +$_kill = sub { my ( $self, $pid ) = @_; return unless $pid; unless ( CORE::kill 0 => $pid ) { @@ -159,42 +151,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 ); + 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(2) 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 @@ -219,8 +217,9 @@ 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 @@ -228,7 +227,7 @@ This module helps provide the basic infrastructure to do that. =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 @@ -240,7 +239,18 @@ 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 @@ -271,31 +281,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 @@ -307,7 +319,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, also L, L, L =head1 INCOMPATIBILITIES @@ -346,10 +358,15 @@ L, L, L Chris Prather C<< >> +=head1 THANKS + +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<< >>. 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.