package MooseX::Daemonize;
use strict; # because Kwalitee is pedantic
use Moose::Role;
+use MooseX::Types::Path::Class;
+use File::Path qw(make_path);
-our $VERSION = 0.01;
-use Carp;
-use Proc::Daemon;
+our $VERSION = '0.16';
-use File::Flock;
-use File::Slurp;
+with 'MooseX::Daemonize::WithPidFile',
+ 'MooseX::Getopt';
-with qw(MooseX::Getopt);
+sub OK () { 0 }
+sub 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 '/' },
+ documentation => 'the name of the daemon',
);
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') },
+ documentation => 'the base for our pid (default: /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';
- },
+has basedir => (
+ metaclass => 'Getopt',
+ isa => 'Path::Class::Dir',
+ is => 'ro',
+ coerce => 1,
+ required => 1,
+ lazy => 1,
+ default => sub { Path::Class::Dir->new('/') },
+ documentation => 'the directory to chdir to (default: /)',
);
has foreground => (
metaclass => 'Getopt',
- cmd_aliases => ['f'],
+ cmd_aliases => 'f',
isa => 'Bool',
is => 'ro',
default => sub { 0 },
+ documentation => 'if true, the process won\'t background',
+);
+
+has stop_timeout => (
+ metaclass => 'Getopt',
+ isa => 'Int',
+ is => 'rw',
+ default => sub { 2 },
+ documentation => 'number of seconds to wait for the process to stop, before trying harder to kill it (default: 2 s)',
+);
+
+# internal book-keeping
+
+has status_message => (
+ metaclass => 'NoGetopt',
+ isa => 'Str',
+ is => 'rw',
+ clearer => 'clear_status_message',
);
-sub check {
- my ($self) = @_;
- if ( my $pid = $self->get_pid ) {
- my $prog = $self->progname;
- if ( CORE::kill 0 => $pid ) {
- croak "$prog already running ($pid).";
+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';
+
+ if ( !-d $self->pidbase ) {
+ make_path( $self->pidbase, { error => \my $err } );
+ if (@$err) {
+ confess sprintf( "Cannot create pidbase directory '%s': %s",
+ $self->pidbase, @$err );
}
- carp "$prog not running but found pid ($pid)."
- . "Perhaps the pid file (@{ [$self->pidfile] }) is stale?";
- return 1;
}
- return 0;
+
+ 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 daemonize {
- my ($self) = @_;
- Proc::Daemon::Init;
+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($self->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($self->ERROR);
+ $self->status_message('Start failed : ' . $@);
+ return !($self->exit_code);
+ }
+ }
+
+ unless ($self->is_daemon) {
+ $self->exit_code($self->OK);
+ $self->status_message('Start succeeded');
+ return !($self->exit_code);
+ }
- $self->daemonize unless $self->foreground;
+ $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 status {
+ my $self = shift;
-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;
-}
+ $self->clear_status_message;
+ $self->clear_exit_code;
-sub get_pid {
- my ($self) = @_;
- my $pidfile = $self->pidfile;
- return unless -e $pidfile;
- chomp( my $pid = read_file($pidfile) );
- return $pid;
-}
+ if ($self->pidfile->is_running) {
+ $self->exit_code($self->OK);
+ $self->status_message('Daemon is running with pid (' . $self->pidfile->pid . ')');
+ }
+ else {
+ $self->exit_code($self->ERROR);
+ $self->status_message('Daemon is not running with pid (' . $self->pidfile->pid . ')');
+ }
-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;
+ return !($self->exit_code);
}
sub restart {
- my ($self) = @_;
- $self->stop( noexit => 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($self->ERROR);
+ $self->status_message('Restart (Stop) failed : ' . $@);
+ }
+
+ unless ($self->start) {
+ $self->exit_code($self->ERROR);
+ $self->status_message('Restart (Start) failed : ' . $@);
+ }
+
+ if ($self->exit_code == $self->OK) {
+ $self->exit_code($self->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 {
+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($self->ERROR);
+ $self->status_message('Stop failed : ' . $@);
+ }
+ # or gloat if we succeed ..
+ else {
+ $self->exit_code($self->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($self->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);
- 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 );
+ while ($timeout) {
+ unless(CORE::kill 0 => $pid or $!{EPERM}) {
+ $terminating_signal = $signal;
+ last;
+ }
+ $timeout--;
+ sleep(1) if $timeout;
+ }
+
+ 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
-
-MooseX::Daemonize - provides a Role that daemonizes your Moose based application.
+=pod
+=head1 NAME
-=head1 VERSION
+MooseX::Daemonize - Role for daemonizing your Moose based application
-This document describes MooseX::Daemonize version 0.0.1
+=head1 WARNING
+The maintainers of this module now recommend using L<Daemon::Control> instead.
=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 ....
+
+ 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();
- no Moose;
+ 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 CAVEATS
+
+When going into background MooseX::Daemonize closes all open file
+handles. This may interfere with you logging because it may also close the log
+file handle you want to write to. To prevent this you can either defer opening
+the log file until after start. Alternatively, use can use the
+'dont_close_all_files' option either from the command line or in your .sh
+script.
+
+Assuming you want to use Log::Log4perl for example you could expand the
+MooseX::Daemonize example above like this.
+
+ after start => sub {
+ my $self = shift;
+ return unless $self->is_daemon;
+ Log::Log4perl->init(\$log4perl_config);
+ my $logger = Log::Log4perl->get_logger();
+ $logger->info("Daemon started");
+ # your daemon code here ...
+ };
+
=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<MooseX::Getopt>'s command line handling, with the
+exception of C<is_daemon>.
+
=over
-=item progname Str
+=item I<progname Path::Class::Dir | Str>
+
+The name of our daemon, defaults to C<$package_name =~ s/::/_/>;
+
+=item I<pidbase Path::Class::Dir | Str>
+
+The base for our PID, defaults to C</var/run/>
+
+=item I<basedir Path::Class::Dir | Str>
+
+The directory we chdir to; defaults to C</>.
-The name of our daemon, defaults to $0
+=item I<pidfile MooseX::Daemonize::Pid::File | Str>
-=item pidbase Str
+The file we store our PID in, defaults to C<$pidbase/$progname.pid>
-The base for our bid, defaults to /var/run/$progname
+=item I<foreground Bool>
-=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<no_double_fork Bool>
-=item foreground Bool
+If true, the process will not perform the typical double-fork, which is extra
+added protection from your process accidentally aquiring a controlling terminal.
+More information can be found by Googling "double fork daemonize".
-If true, the process won't background. Useful for debugging. This option can be set via Getopt's -f.
+=item I<ignore_zombies Bool>
+
+If true, the process will not clean up zombie processes.
+Normally you don't want this.
+
+=item I<dont_close_all_files Bool>
+
+If true, the objects open filehandles will not be closed when daemonized.
+Normally you don't want this.
+
+
+=item I<is_daemon 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<after 'start' => sub { }>
+block.
+
+B<NOTE:> This option is explicitly B<not> available through L<MooseX::Getopt>.
+
+=item I<stop_timeout>
+
+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<exit_code Int>
+
+=item I<status_message Str>
+
+=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<Moose> method modifiers,
+such as C<before>, C<after> and C<around>.
+
+=over 4
+
+=item B<start>
Setup a pidfile, fork, then setup the signal handlers.
-=item stop()
+=item B<stop>
Stop the process matching the pidfile, and unlinks the pidfile.
-=item restart()
+=item B<restart>
-Litterally
+Literally this is:
$self->stop();
$self->start();
-=item daemonize()
+=item B<status>
-Calls C<Proc::Daemon::Init> to daemonize this process.
+=item B<shutdown>
-=item kill($pid)
+=back
-Kills the process for $pid. This will try SIGINT, and SIGTERM before falling back to SIGKILL and finally giving up.
-=item setup_signals()
+=head2 Pidfile Handling Methods
-Setup the signal handlers, by default it only sets up handlers for SIGINT and SIGHUP
+=over 4
-=item handle_sigint()
+=item B<init_pidfile>
-Handle a INT signal, by default calls C<$self->stop()>;
+This method will create a L<MooseX::Daemonize::Pid::File> object and tell
+it to store the PID in the file C<$pidbase/$progname.pid>.
-=item handle_sighup()
+=item B<check>
-Handle a HUP signal. Nothing is done by default.
+This checks to see if the daemon process is currently running by checking
+the pidfile.
-=item get_pid
+=item B<get_pid>
-=item save_pid
+Returns the PID of the daemon process.
-=item remove_pid
+=item B<save_pid>
-=item meta()
+Write the pidfile.
+
+=item B<remove_pid>
-the C<meta()> method from L<Class::MOP::Class>
+Removes the pidfile.
=back
-=head1 DEPENDENCIES
+=head2 Signal Handling Methods
-=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. ]
+=over 4
-Obviously L<Moose>, also L<Carp>, L<Proc::Daemon>, L<File::Flock>, L<File::Slurp>
+=item B<setup_signals>
-=head1 INCOMPATIBILITIES
+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<after> method modifier
+and add them.
-=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).
+=item B<handle_sigint>
-None reported.
+Handle a INT signal, by default calls C<$self->stop()>
+=item B<handle_sighup>
-=head1 BUGS AND LIMITATIONS
+Handle a HUP signal. By default calls C<$self->restart()>
+
+=back
+
+=head2 Exit Code Methods
+
+These are overriable constant methods used for setting the exit code.
-=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.
+=over 4
+
+=item OK
+
+Returns 0.
+
+=item ERROR
+
+Returns 1.
+
+=back
+
+=head2 Introspection
+
+=over 4
+
+=item meta()
+
+The C<meta()> method from L<Class::MOP::Class>
+
+=back
+
+=head1 DEPENDENCIES
+
+L<Moose>, L<MooseX::Getopt>, L<MooseX::Types::Path::Class> and L<POSIX>
+
+=head1 INCOMPATIBILITIES
+
+None reported. Although obviously this will not work on Windows.
+
+=head1 BUGS AND LIMITATIONS
No bugs have been reported.
=head1 SEE ALSO
-L<Proc::Daemon>, L<Daemon::Generic>, L<MooseX::Getopt>
+L<Daemon::Control>, L<Proc::Daemon>, L<Daemon::Generic>
+
+=head1 AUTHORS
-=head1 AUTHOR
+Chris Prather C<< <chris@prather.org >>
-Chris Prather C<< <perigrin@cpan.org> >>
+Stevan Little C<< <stevan.little@iinteractive.com> >>
+=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-2011, Chris Prather C<< <chris@prather.org> >>. Some 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>.
-
=head1 DISCLAIMER OF WARRANTY
BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
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