Fix logic in _kill

diff --git a/Changes b/Changes
index 919fcc9..9e83776 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,14 +1,24 @@
 Revision history for MooseX-Daemonize
 
-0.02 ???
-       - Fixed bug where sometimes the pidfile is writeable but pidbase is not --  reported by dec 
+    - Fix logic that kills process so it doens't always warn about undead 
+      process
+    - Added stop_timeout to allow user to control timings.
+
+0.04 2007-11-11
+    - Fix stupid perlcritic.t cause the Module::Starter::PBP tests were stupid but I didn't realize it.
+
+0.03 2007-10-22
+    - Add File::Slurp to dependencies so our tests pass better
+
+0.02 Sept 19, 2007
+    - Fixed bug where sometimes the pidfile is writeable but pidbase is not --  reported by dec 
     - Fixed bug where the pidfile wasn't being updated properly --  reported by dec 
-       - Added is_daemon attribute
-       - Added another fork to make sure we short circuit out of the daemonize process properly
-       - Switch to File::Pid
+    - Added is_daemon attribute
+    - Added another fork to make sure we short circuit out of the daemonize process properly
+    - Switch to File::Pid
     - Add the GetOpt prereq
-       - Adjust the kill timings
-       - Added THANKS to pod
+    - Adjust the kill timings
+    - Added THANKS to pod
 
 0.0.1  Wed May 16 11:46:56 2007
        Initial release.

diff --git a/lib/MooseX/Daemonize.pm b/lib/MooseX/Daemonize.pm
index a59f794..cb3d249 100644 (file)
--- a/lib/MooseX/Daemonize.pm
+++ b/lib/MooseX/Daemonize.pm
@@ -2,7 +2,7 @@ package MooseX::Daemonize;
 use strict;    # because Kwalitee is pedantic
 use Moose::Role;
 
-our $VERSION = 0.02;
+our $VERSION = 0.04;
 use Carp;
 use Proc::Daemon;
 
@@ -77,6 +77,12 @@ has is_daemon => (
     default => sub { 0 },
 );
 
+has stop_timeout => (
+    isa     => 'Int',
+    is      => 'rw',
+    default => 2
+);
+
 sub daemonize {
     my ($self) = @_;
     return if Proc::Daemon::Fork;
@@ -107,10 +113,13 @@ sub start {
     return $$;
 }
 
+# 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;
@@ -131,8 +140,7 @@ sub setup_signals {
 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 ) {
@@ -143,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(3) 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;
+
+      CORE::kill($signal, $pid);
+
+      last unless CORE::kill 0 => $pid or $!{EPERM};
 
-    unless ( CORE::kill 0 => $pid or $!{EPERM} ) {    # IF it is still running
-        carp "$pid doesn't seem to want to die.";     # AHH EVIL DEAD!
+      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
 
@@ -203,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
 
@@ -224,11 +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
+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
 
@@ -259,10 +281,6 @@ Litterally
 
 Calls C<Proc::Daemon::Init> 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
@@ -342,11 +360,13 @@ Chris Prather  C<< <perigrin@cpan.org> >>
 
 =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
 
 =head1 LICENCE AND COPYRIGHT
 
-Copyright (c) 2007, Chris Prather C<< <perigrin@cpan.org> >>. All rights reserved.
+Copyright (c) 2007, Chris Prather C<< <perigrin@cpan.org> >>. 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<perlartistic>.

diff --git a/t/01.filecreate.t b/t/01.filecreate.t
index fba64ec..7794164 100644 (file)
--- a/t/01.filecreate.t
+++ b/t/01.filecreate.t
@@ -25,6 +25,8 @@ use MooseX::Daemonize;
 }
 
 package main;
+use strict;
+use warnings;
 use Cwd;
 
 ## Try to make sure we are in the test directory
@@ -36,7 +38,7 @@ my $app = FileMaker->new(
     filename => "$cwd/im_alive",
 );
 daemonize_ok( $app, 'child forked okay' );
-ok( -e $app->filename, "$file exists" );
+ok( -e $app->filename, "file exists" );
 ok( $app->stop( no_exit => 1 ), 'app stopped' );
-ok( -e $app->pidfile == undef, 'pidfile gone' );
+ok( not(-e $app->pidfile) , 'pidfile gone' );
 unlink( $app->filename );

diff --git a/t/02.stdout.t b/t/02.stdout.t
index 5ce4e99..f76a392 100644 (file)
--- a/t/02.stdout.t
+++ b/t/02.stdout.t
@@ -30,6 +30,8 @@ my $Test = Test::Builder->new;
 
 package main;
 use Cwd;
+use strict;
+use warnings;
 
 ## Try to make sure we are in the test directory
 chdir 't' if ( Cwd::cwd() !~ m|/t$| );
@@ -40,7 +42,14 @@ my $app = TestOutput->new(
 );
 daemonize_ok( $app, 'child forked okay' );
 sleep(3);    # give ourself a chance to produce some output
-$app->stop( no_exit => 1 );
+
+my $warnings = "";
+{
+       local $SIG{__WARN__} = sub { $warnings .= $_[0]; warn @_ };
+       $app->stop( no_exit => 1 );
+}
+
+is($warnings, "", "No warnings from stop");
 
 check_test_output($app);
 unlink( $app->test_output );