X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FDaemonize.pm;h=ffae57707438a5bcc09a6e94ae371a91ec582422;hb=2eced27121e8557fe773f6f8804786f29f5660c1;hp=2a12ce8cde94cd85b665f6522df4cfcf792ad097;hpb=cbff8e5216c7e752ed8f2e64e0f200e1d3c9c718;p=gitmo%2FMooseX-Daemonize.git

diff --git a/lib/MooseX/Daemonize.pm b/lib/MooseX/Daemonize.pm
index 2a12ce8..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.02;
-use Carp;
-use Proc::Daemon;
+our $VERSION = 0.05;
 
-use File::Pid;
-use Moose::Util::TypeConstraints;
+use Carp 'carp';
+use Proc::Daemon;
+use MooseX::Daemonize::PidFile;
 
 with qw(MooseX::Getopt);
 
@@ -23,48 +24,49 @@ has progname => (
 );
 
 has basedir => (
-    isa      => 'Str',
+    isa      => 'Path::Class::Dir',
     is       => 'ro',
+    coerce   => 1,
     required => 1,
     lazy     => 1,
-    default  => sub { return '/' },
+    default  => sub { Path::Class::Dir->new('/') },
 );
 
 has pidbase => (
-    isa      => 'Str',
+    isa      => 'Path::Class::Dir',
     is       => 'ro',
+    coerce   => 1,
+    required => 1,    
     lazy     => 1,
-    required => 1,
-    default  => sub { return '/var/run' },
+    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 => $_, } ); };
+coerce 'MooseX::Daemonize::PidFile' 
+    => from 'Str' 
+        => via { MooseX::Daemonize::PidFile->new( file => $_ ) };
 
 has pidfile => (
-    isa       => 'Pidfile',
+    isa       => 'MooseX::Daemonize::PidFile',
     is        => 'rw',
     lazy      => 1,
     required  => 1,
     coerce    => 1,
     predicate => 'has_pidfile',
     default   => sub {
-        die 'Cannot write to ' . $_[0]->pidbase unless -w $_[0]->pidbase;
         my $file = $_[0]->pidbase . '/' . $_[0]->progname . '.pid';
-        File::Pid->new( { file => $file } );
+        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',
-        _pidfile   => 'file',
     },
 );
 
 has foreground => (
-    metaclass   => 'MooseX::Getopt::Meta::Attribute',
+    metaclass   => 'Getopt',
     cmd_aliases => 'f',
     isa         => 'Bool',
     is          => 'ro',
@@ -77,6 +79,12 @@ has is_daemon => (
     default => sub { 0 },
 );
 
+has stop_timeout => (
+    isa     => 'Int',
+    is      => 'rw',
+    default => sub { 2 }
+);
+
 sub daemonize {
     my ($self) = @_;
     return if Proc::Daemon::Fork;
@@ -86,7 +94,9 @@ sub daemonize {
 
 sub start {
     my ($self) = @_;
+    
     confess "instance already running" if $self->check;
+    
     $self->daemonize unless $self->foreground;
 
     return unless $self->is_daemon;
@@ -107,10 +117,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 +144,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 +155,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);
 
-    unless ( CORE::kill 0 => $pid or $!{EPERM} ) {    # IF it is still running
-        carp "$pid doesn't seem to want to die.";     # AHH EVIL DEAD!
+      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
 
@@ -203,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 $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
 
@@ -255,10 +285,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
@@ -297,7 +323,7 @@ The C<meta()> method from L<Class::MOP::Class>
     the module is part of the standard Perl distribution, part of the
     module's distribution, or must be installed separately. ]
 
-Obviously L<Moose>, also L<Carp>, L<Proc::Daemon>, L<File::Pid>
+Obviously L<Moose>, and L<Proc::Daemon>
 
 =head1 INCOMPATIBILITIES
 
@@ -338,11 +364,15 @@ 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
+
+Some bug fixes sponsored by Takkle Inc.
 
 =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>.