package MooseX::Daemonize;
use strict; # because Kwalitee is pedantic
use Moose::Role;
-
-use MooseX::Daemonize::Types;
+use MooseX::Types::Path::Class;
our $VERSION = 0.05;
-with qw[
- MooseX::Daemonize::Core
- MooseX::Daemonize::WithSignalHandling
- MooseX::Daemonize::WithPidFile
- MooseX::Getopt
-];
+with 'MooseX::Daemonize::WithPidFile',
+ 'MooseX::Getopt';
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 pidbase => (
- isa => 'Path::Class::Dir',
- is => 'ro',
- coerce => 1,
- required => 1,
- lazy => 1,
- default => sub { Path::Class::Dir->new('var', 'run') },
+ metaclass => 'Getopt',
+ isa => 'Path::Class::Dir',
+ is => 'ro',
+ coerce => 1,
+ required => 1,
+ lazy => 1,
+ default => sub { Path::Class::Dir->new('var', 'run') },
);
has basedir => (
- isa => 'Path::Class::Dir',
- is => 'ro',
- coerce => 1,
- required => 1,
- lazy => 1,
- default => sub { Path::Class::Dir->new('/') },
+ metaclass => 'Getopt',
+ isa => 'Path::Class::Dir',
+ is => 'ro',
+ coerce => 1,
+ required => 1,
+ lazy => 1,
+ default => sub { Path::Class::Dir->new('/') },
);
has foreground => (
);
has stop_timeout => (
- isa => 'Int',
- is => 'rw',
- default => sub { 2 }
+ metaclass => 'Getopt',
+ isa => 'Int',
+ is => 'rw',
+ default => sub { 2 }
+);
+
+# internal book-keeping
+
+has status_message => (
+ metaclass => 'NoGetopt',
+ isa => 'Str',
+ is => 'rw',
+ clearer => 'clear_status_message',
);
+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';
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->handle_sigint };
+ $SIG{'HUP'} = sub { $self->handle_sighup };
+}
+
+sub handle_sigint { $_[0]->stop }
+sub handle_sighup { $_[0]->restart }
+
+## daemon control methods ...
+
sub start {
- my ($self) = @_;
-
- confess "instance already running" if $self->pidfile->is_running;
+ my $self = shift;
+
+ $self->clear_status_message;
+ $self->clear_exit_code;
+
+ if ($self->pidfile->is_running) {
+ $self->status_message('Daemon is already running with pid (' . $self->pidfile->pid . ')');
+ return !($self->exit_code);
+ }
- $self->daemonize unless $self->foreground;
+ if ($self->foreground) {
+ $self->is_daemon(1);
+ }
+ else {
+ eval { $self->daemonize };
+ if ($@) {
+ $self->exit_code(1);
+ $self->status_message('Start failed : ' . $@);
+ return !($self->exit_code);
+ }
+ }
- return unless $self->is_daemon;
+ unless ($self->is_daemon) {
+ $self->status_message('Start succeeded');
+ return !($self->exit_code);
+ }
$self->pidfile->pid($$);
return $$;
}
-# Make _kill *really* private
-my $_kill;
+sub status {
+ my $self = shift;
-sub stop {
- my ( $self, %args ) = @_;
- my $pid = $self->pidfile->pid;
- $self->$_kill($pid) unless $self->foreground();
- $self->pidfile->remove;
- return 1 if $args{no_exit};
- exit;
+ $self->clear_status_message;
+ $self->clear_exit_code;
+
+ if ($self->pidfile->is_running) {
+ $self->status_message('Daemon is running with pid (' . $self->pidfile->pid . ')');
+ }
+ else {
+ $self->exit_code(1);
+ $self->status_message('Daemon is not running with pid (' . $self->pidfile->pid . ')');
+ }
+
+ return !($self->exit_code);
}
sub restart {
- my ($self) = @_;
- $self->stop( no_exit => 1 );
- $self->start();
-}
+ my $self = shift;
-sub handle_signal {
- my ($self, $signal) = @_;
- return $self->handle_sigint if $signal eq 'INT';
- return $self->handle_sighup if $signal eq 'HUP';
+ $self->clear_status_message;
+ $self->clear_exit_code;
+
+ unless ($self->stop) {
+ $self->exit_code(1);
+ $self->status_message('Restart (Stop) failed : ' . $@);
+ }
+
+ unless ($self->start) {
+ $self->exit_code(1);
+ $self->status_message('Restart (Start) failed : ' . $@);
+ }
+
+ $self->status_message("Restart successful")
+ if !$self->exit_code;
+
+ return !($self->exit_code);
}
-sub handle_sigint { $_[0]->stop; }
-sub handle_sighup { $_[0]->restart; }
+# Make _kill *really* private
+my $_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(1);
+ $self->status_message('Stop failed : ' . $@);
+ }
+ # or gloat if we succeed ..
+ else {
+ $self->status_message('Stop succeeded');
+ }
+
+ }
+
+ # clean up ...
+ eval { $self->pidfile->remove };
+ if ($@) {
+ warn "Could not remove pidfile ("
+ . $self->pidfile->file
+ . ") because : $!";
+ }
+
+ }
+ else {
+ # this just returns the OK
+ # exit code for now, but
+ # we should make this overridable
+ $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 ) = @_;
# kill 0 => $pid returns 0 if the process is dead
# $!{EPERM} could also be true if we cant kill it (permission error)
+ # if this is being called
+ # inside the daemon then
+ # we don't want sig-INT to
+ # fall into a loop here
+ # so we reset it.
+ if ($self->is_daemon) {
+ $SIG{INT} = 'DEFAULT';
+ }
+
# 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};
1;
__END__
+=pod
+
=head1 NAME
-MooseX::Daemonize - provides a Role that daemonizes your Moose based
+MooseX::Daemonize - provides a Role that daemonizes your Moose based
application.
=head1 VERSION
-This document describes MooseX::Daemonize version 0.04
+This document describes MooseX::Daemonize version 0.05
=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 ....
- no Moose;
+ 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();
+
+ 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);
+ 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.
+appropriately to Signals. This module provides a set of basic roles as an
+infrastructure to do that.
=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 Path::Class::Dir | Str
+=item I<progname Path::Class::Dir | Str>
-The name of our daemon, defaults to $self->meta->name =~ s/::/_/;
+The name of our daemon, defaults to C<$package_name =~ s/::/_/>;
-=item pidbase Path::Class::Dir | Str
+=item I<pidbase Path::Class::Dir | Str>
-The base for our bid, defaults to /var/run/$progname
+The base for our bid, defaults to C</var/run/$progname>
-=item pidfile MooseX::Daemonize::Pid::File | Str
+=item I<pidfile MooseX::Daemonize::Pid::File | Str>
-The file we store our PID in, defaults to /var/run/$progname
+The file we store our PID in, defaults to C</var/run/$progname>
-=item foreground Bool
+=item I<foreground Bool>
-If true, the process won't background. Useful for debugging. This option can
+If true, the process won't background. Useful for debugging. This option can
be set via Getopt's -f.
-=item is_daemon Bool
+=item I<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 daemon process, if false it is the
+parent process. This is useful for example in an C<after 'start' => sub { }>
+block.
-=item stop_timeout
+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
+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 Str>
+
+=back
+
+=head1 METHODS
+
+=head2 Daemon Control Methods
+
+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.
-=item start()
+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.
+=back
-=item setup_signals()
-Setup the signal handlers, by default it only sets up handlers for SIGINT and SIGHUP
+=head2 Pidfile Handling Methods
-=item handle_sigint()
+=over 4
+
+=item B<init_pidfile>
+
+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 B<check>
+
+This checks to see if the daemon process is currently running by checking
+the pidfile.
+
+=item B<get_pid>
+
+Returns the PID of the daemon process.
+
+=item B<save_pid>
+
+Write the pidfile.
+
+=item B<remove_pid>
+
+Removes the pidfile.
+
+=back
+
+=head2 Signal Handling Methods
+
+=over 4
+
+=item B<setup_signals>
+
+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.
+
+=item B<handle_sigint>
Handle a INT signal, by default calls C<$self->stop()>
-=item handle_sighup()
+=item B<handle_sighup>
Handle a HUP signal. By default calls C<$self->restart()>
+=back
+
+=head2 Introspection
+
+=over 4
+
=item meta()
The C<meta()> method from L<Class::MOP::Class>
=head1 DEPENDENCIES
-=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. ]
-
-Obviously L<Moose>, and L<Proc::Daemon>
+L<Moose>, L<MooseX::Getopt>, L<MooseX::Types::Path::Class> and L<POSIX>
=head1 INCOMPATIBILITIES
-=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).
-
-None reported.
-
+None reported. Although obviously this will not work on Windows.
=head1 BUGS AND LIMITATIONS
-=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.
-
No bugs have been reported.
Please report any bugs or feature requests to
=head1 SEE ALSO
-L<Proc::Daemon>, L<Daemon::Generic>, L<MooseX::Getopt>
+L<Proc::Daemon>, L<Daemon::Generic>
=head1 AUTHOR
=head1 THANKS
-Mike Boyko, Matt S. Trout, Stevan Little, Brandon Black, Ash Berlin and the
+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
+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>.
-
=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