1 package MooseX::Daemonize;
2 use strict; # because Kwalitee is pedantic
4 use MooseX::Types::Path::Class;
8 with 'MooseX::Daemonize::WithPidFile',
12 use constant ERROR => 1;
15 metaclass => 'Getopt',
21 ( my $name = lc $_[0]->meta->name ) =~ s/::/_/g;
27 metaclass => 'Getopt',
28 isa => 'Path::Class::Dir',
33 default => sub { Path::Class::Dir->new('var', 'run') },
37 metaclass => 'Getopt',
38 isa => 'Path::Class::Dir',
43 default => sub { Path::Class::Dir->new('/') },
47 metaclass => 'Getopt',
55 metaclass => 'Getopt',
61 # internal book-keeping
63 has status_message => (
64 metaclass => 'NoGetopt',
67 clearer => 'clear_status_message',
71 metaclass => 'NoGetopt',
74 clearer => 'clear_exit_code',
79 ## PID file related stuff ...
83 my $file = $self->pidbase . '/' . $self->progname . '.pid';
84 confess "Cannot write to $file" unless (-e $file ? -w $file : -w $self->pidbase);
85 MooseX::Daemonize::Pid::File->new( file => $file );
89 sub check { (shift)->pidfile->is_running }
90 sub save_pid { (shift)->pidfile->write }
91 sub remove_pid { (shift)->pidfile->remove }
92 sub get_pid { (shift)->pidfile->pid }
94 ## signal handling ...
98 $SIG{'INT'} = sub { $self->shutdown };
99 # I can't think of a sane default here really ...
100 # $SIG{'HUP'} = sub { $self->handle_sighup };
105 $self->pidfile->remove if $self->pidfile->pid == $$;
109 ## daemon control methods ...
114 $self->clear_status_message;
115 $self->clear_exit_code;
117 if ($self->pidfile->is_running) {
118 $self->exit_code(OK);
119 $self->status_message('Daemon is already running with pid (' . $self->pidfile->pid . ')');
120 return !($self->exit_code);
123 if ($self->foreground) {
127 eval { $self->daemonize };
129 $self->exit_code(ERROR);
130 $self->status_message('Start failed : ' . $@);
131 return !($self->exit_code);
135 unless ($self->is_daemon) {
136 $self->exit_code(OK);
137 $self->status_message('Start succeeded');
138 return !($self->exit_code);
141 $self->pidfile->pid($$);
144 chdir $self->basedir;
146 $self->pidfile->write;
147 $self->setup_signals;
154 $self->clear_status_message;
155 $self->clear_exit_code;
157 if ($self->pidfile->is_running) {
158 $self->exit_code(OK);
159 $self->status_message('Daemon is running with pid (' . $self->pidfile->pid . ')');
162 $self->exit_code(ERROR);
163 $self->status_message('Daemon is not running with pid (' . $self->pidfile->pid . ')');
166 return !($self->exit_code);
172 $self->clear_status_message;
173 $self->clear_exit_code;
175 unless ($self->stop) {
176 $self->exit_code(ERROR);
177 $self->status_message('Restart (Stop) failed : ' . $@);
180 unless ($self->start) {
181 $self->exit_code(ERROR);
182 $self->status_message('Restart (Start) failed : ' . $@);
185 if ($self->exit_code == OK) {
186 $self->exit_code(OK);
187 $self->status_message("Restart successful");
190 return !($self->exit_code);
193 # Make _kill *really* private
199 $self->clear_status_message;
200 $self->clear_exit_code;
202 # if the pid is not running
203 # then we dont need to stop
205 if ($self->pidfile->is_running) {
207 # if we are foreground, then
208 # no need to try and kill
210 unless ($self->foreground) {
212 # kill the process ...
213 eval { $self->$_kill($self->pidfile->pid) };
214 # and complain if we can't ...
216 $self->exit_code(ERROR);
217 $self->status_message('Stop failed : ' . $@);
219 # or gloat if we succeed ..
221 $self->exit_code(OK);
222 $self->status_message('Stop succeeded');
228 eval { $self->pidfile->remove };
230 warn "Could not remove pidfile ("
231 . $self->pidfile->file
237 # this just returns the OK
238 # exit code for now, but
239 # we should make this overridable
240 $self->exit_code(OK);
241 $self->status_message("Not running");
244 # if we are returning to our script
245 # then we actually need the opposite
246 # of what the system/OS expects
247 return !($self->exit_code);
251 my ( $self, $pid ) = @_;
253 unless ( CORE::kill 0 => $pid ) {
254 # warn "$pid already appears dead.";
259 die "$pid is us! Can't commit suicide.";
262 my $timeout = $self->stop_timeout;
264 # kill 0 => $pid returns 0 if the process is dead
265 # $!{EPERM} could also be true if we cant kill it (permission error)
267 # Try SIGINT ... 2s ... SIGTERM ... 2s ... SIGKILL ... 3s ... UNDEAD!
268 for ( [ 2, $timeout ], [15, $timeout], [9, $timeout * 1.5] ) {
269 my ($signal, $timeout) = @$_;
270 $timeout = int $timeout;
272 CORE::kill($signal, $pid);
274 last unless CORE::kill 0 => $pid or $!{EPERM};
278 last unless CORE::kill 0 => $pid or $!{EPERM};
283 return unless ( CORE::kill 0 => $pid or $!{EPERM} );
285 # IF it is still running
286 Carp::carp "$pid doesn't seem to want to die."; # AHH EVIL DEAD!
296 MooseX::Daemonize - provides a Role that daemonizes your Moose based
301 This document describes MooseX::Daemonize version 0.05
308 with qw(MooseX::Daemonize);
310 # ... define your class ....
314 return unless $self->is_daemon;
315 # your daemon code here ...
318 # then in your script ...
320 my $daemon = My::Daemon->new_with_options();
322 my ($command) = @{$daemon->extra_argv}
323 defined $command || die "No command specified";
325 $daemon->start if $command eq 'start';
326 $daemon->status if $command eq 'status';
327 $daemon->restart if $command eq 'restart';
328 $daemon->stop if $command eq 'stop';
330 warn($daemon->status_message);
331 exit($daemon->exit_code);
335 Often you want to write a persistant daemon that has a pid file, and responds
336 appropriately to Signals. This module provides a set of basic roles as an
337 infrastructure to do that.
341 This list includes attributes brought in from other roles as well
342 we include them here for ease of documentation. All of these attributes
343 are settable though L<MooseX::Getopt>'s command line handling, with the
344 exception of C<is_daemon>.
348 =item I<progname Path::Class::Dir | Str>
350 The name of our daemon, defaults to C<$package_name =~ s/::/_/>;
352 =item I<pidbase Path::Class::Dir | Str>
354 The base for our bid, defaults to C</var/run/$progname>
356 =item I<pidfile MooseX::Daemonize::Pid::File | Str>
358 The file we store our PID in, defaults to C</var/run/$progname>
360 =item I<foreground Bool>
362 If true, the process won't background. Useful for debugging. This option can
363 be set via Getopt's -f.
365 =item I<is_daemon Bool>
367 If true, the process is the backgrounded daemon process, if false it is the
368 parent process. This is useful for example in an C<after 'start' => sub { }>
371 B<NOTE:> This option is explicitly B<not> available through L<MooseX::Getopt>.
373 =item I<stop_timeout>
375 Number of seconds to wait for the process to stop, before trying harder to kill
376 it. Defaults to 2 seconds.
380 These are the internal attributes, which are not available through MooseX::Getopt.
384 =item I<exit_code Int>
386 =item I<status_message Str>
392 =head2 Daemon Control Methods
394 These methods can be used to control the daemon behavior. Every effort
395 has been made to have these methods DWIM (Do What I Mean), so that you
396 can focus on just writing the code for your daemon.
398 Extending these methods is best done with the L<Moose> method modifiers,
399 such as C<before>, C<after> and C<around>.
405 Setup a pidfile, fork, then setup the signal handlers.
409 Stop the process matching the pidfile, and unlinks the pidfile.
425 =head2 Pidfile Handling Methods
429 =item B<init_pidfile>
431 This method will create a L<MooseX::Daemonize::Pid::File> object and tell
432 it to store the PID in the file C<$pidbase/$progname.pid>.
436 This checks to see if the daemon process is currently running by checking
441 Returns the PID of the daemon process.
453 =head2 Signal Handling Methods
457 =item B<setup_signals>
459 Setup the signal handlers, by default it only sets up handlers for SIGINT and
460 SIGHUP. If you wish to add more signals just use the C<after> method modifier
463 =item B<handle_sigint>
465 Handle a INT signal, by default calls C<$self->stop()>
467 =item B<handle_sighup>
469 Handle a HUP signal. By default calls C<$self->restart()>
479 The C<meta()> method from L<Class::MOP::Class>
485 L<Moose>, L<MooseX::Getopt>, L<MooseX::Types::Path::Class> and L<POSIX>
487 =head1 INCOMPATIBILITIES
489 None reported. Although obviously this will not work on Windows.
491 =head1 BUGS AND LIMITATIONS
493 No bugs have been reported.
495 Please report any bugs or feature requests to
496 C<bug-acme-dahut-call@rt.cpan.org>, or through the web interface at
497 L<http://rt.cpan.org>.
501 L<Proc::Daemon>, L<Daemon::Generic>
505 Chris Prather C<< <perigrin@cpan.org> >>
507 Stevan Little C<< <stevan.little@iinteractive.com> >>
511 Mike Boyko, Matt S. Trout, Stevan Little, Brandon Black, Ash Berlin and the
514 Some bug fixes sponsored by Takkle Inc.
516 =head1 LICENCE AND COPYRIGHT
518 Copyright (c) 2007, Chris Prather C<< <perigrin@cpan.org> >>. All rights
521 This module is free software; you can redistribute it and/or
522 modify it under the same terms as Perl itself. See L<perlartistic>.
524 =head1 DISCLAIMER OF WARRANTY
526 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
527 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
528 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
529 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
530 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
531 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
532 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
533 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
534 NECESSARY SERVICING, REPAIR, OR CORRECTION.
536 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
537 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
538 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
539 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
540 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
541 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
542 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
543 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
544 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF