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);
+with qw[
+ MooseX::Daemonize::Core
+ MooseX::Daemonize::SignalHandling
+ MooseX::Getopt
+];
has progname => (
isa => 'Str',
},
);
-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 {
- die 'Cannot write to ' . $_[0]->pidbase unless -w $_[0]->pidbase;
- $_[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 );
},
);
has foreground => (
metaclass => 'Getopt',
- cmd_aliases => ['f'],
+ 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 $pid exists. Perhaps it is stale?";
- return 1;
- }
- return 0;
-}
-sub daemonize {
- my ($self) = @_;
- Proc::Daemon::Init;
-}
+has stop_timeout => (
+ isa => 'Int',
+ is => 'rw',
+ default => sub { 2 }
+);
sub start {
my ($self) = @_;
- return if $self->check;
-
+
+ confess "instance already running" if $self->pidfile->running;
+
$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' );
<NULL> if (0);
+ ## use critic
+
+ # Change to basedir
+ chdir $self->basedir;
- $self->save_pid;
+ $self->pidfile->write;
$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->remove_pid;
+ my $pid = $self->pidfile->pid;
+ $self->$_kill($pid) unless $self->foreground();
+ $self->pidfile->remove;
return 1 if $args{no_exit};
exit;
}
sub restart {
my ($self) = @_;
- $self->stop( noexit => 1 );
+ $self->stop( no_exit => 1 );
$self->start();
}
-sub setup_signals {
- my ($self) = @_;
- $SIG{INT} = sub { $self->handle_sigint; };
- $SIG{HUP} = sub { $self->handle_sighup };
+sub handle_signal {
+ my ($self, $signal) = @_;
+ return $self->handle_sigint if $signal eq 'INT';
+ return $self->handle_sighup if $signal eq 'HUP';
}
-sub handle_sigint { $_[0]->stop }
-sub handle_sighup { return; }
+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 ) {
# warn "$pid already appears dead.";
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(1) if CORE::kill( 0, $pid );
-
- unless ( CORE::kill 0 => $pid or $!{EPERM} ) { # IF it is still running
- CORE::kill( 15, $pid ); # try SIGTERM
- sleep(1) if CORE::kill( 0, $pid );
+ my $timeout = $self->stop_timeout;
+
+ # 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--;
+ }
}
- unless ( CORE::kill 0 => $pid or $!{EPERM} ) { # IF it is still running
- CORE::kill( 9, $pid ); # finally try SIGKILL
- sleep(1) if CORE::kill( 0, $pid );
- }
+ return 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!
- }
-
- return;
-}
+ # 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
=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
=over
-=item check()
-
-Check to see if an instance is already running.
-
=item start()
Setup a pidfile, fork, then setup the signal handlers.
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
=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.
-
-=item get_pid
-
-=item save_pid
-
-=item remove_pid
+Handle a HUP signal. By default calls C<$self->restart()>
=item meta()
-the C<meta()> method from L<Class::MOP::Class>
+The C<meta()> method from L<Class::MOP::Class>
=back
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::Flock>, L<File::Slurp>
+Obviously L<Moose>, and L<Proc::Daemon>
=head1 INCOMPATIBILITIES
Chris Prather C<< <perigrin@cpan.org> >>
+=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<< <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>.
projects / gitmo/MooseX-Daemonize.git / blobdiff