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 - Role for daemonizing your Moose based application
300 This document describes MooseX::Daemonize version 0.05
307 with qw(MooseX::Daemonize);
309 # ... define your class ....
313 return unless $self->is_daemon;
314 # your daemon code here ...
317 # then in your script ...
319 my $daemon = My::Daemon->new_with_options();
321 my ($command) = @{$daemon->extra_argv}
322 defined $command || die "No command specified";
324 $daemon->start if $command eq 'start';
325 $daemon->status if $command eq 'status';
326 $daemon->restart if $command eq 'restart';
327 $daemon->stop if $command eq 'stop';
329 warn($daemon->status_message);
330 exit($daemon->exit_code);
334 Often you want to write a persistant daemon that has a pid file, and responds
335 appropriately to Signals. This module provides a set of basic roles as an
336 infrastructure to do that.
340 This list includes attributes brought in from other roles as well
341 we include them here for ease of documentation. All of these attributes
342 are settable though L<MooseX::Getopt>'s command line handling, with the
343 exception of C<is_daemon>.
347 =item I<progname Path::Class::Dir | Str>
349 The name of our daemon, defaults to C<$package_name =~ s/::/_/>;
351 =item I<pidbase Path::Class::Dir | Str>
353 The base for our bid, defaults to C</var/run/$progname>
355 =item I<pidfile MooseX::Daemonize::Pid::File | Str>
357 The file we store our PID in, defaults to C</var/run/$progname>
359 =item I<foreground Bool>
361 If true, the process won't background. Useful for debugging. This option can
362 be set via Getopt's -f.
364 =item I<is_daemon Bool>
366 If true, the process is the backgrounded daemon process, if false it is the
367 parent process. This is useful for example in an C<after 'start' => sub { }>
370 B<NOTE:> This option is explicitly B<not> available through L<MooseX::Getopt>.
372 =item I<stop_timeout>
374 Number of seconds to wait for the process to stop, before trying harder to kill
375 it. Defaults to 2 seconds.
379 These are the internal attributes, which are not available through MooseX::Getopt.
383 =item I<exit_code Int>
385 =item I<status_message Str>
391 =head2 Daemon Control Methods
393 These methods can be used to control the daemon behavior. Every effort
394 has been made to have these methods DWIM (Do What I Mean), so that you
395 can focus on just writing the code for your daemon.
397 Extending these methods is best done with the L<Moose> method modifiers,
398 such as C<before>, C<after> and C<around>.
404 Setup a pidfile, fork, then setup the signal handlers.
408 Stop the process matching the pidfile, and unlinks the pidfile.
424 =head2 Pidfile Handling Methods
428 =item B<init_pidfile>
430 This method will create a L<MooseX::Daemonize::Pid::File> object and tell
431 it to store the PID in the file C<$pidbase/$progname.pid>.
435 This checks to see if the daemon process is currently running by checking
440 Returns the PID of the daemon process.
452 =head2 Signal Handling Methods
456 =item B<setup_signals>
458 Setup the signal handlers, by default it only sets up handlers for SIGINT and
459 SIGHUP. If you wish to add more signals just use the C<after> method modifier
462 =item B<handle_sigint>
464 Handle a INT signal, by default calls C<$self->stop()>
466 =item B<handle_sighup>
468 Handle a HUP signal. By default calls C<$self->restart()>
478 The C<meta()> method from L<Class::MOP::Class>
484 L<Moose>, L<MooseX::Getopt>, L<MooseX::Types::Path::Class> and L<POSIX>
486 =head1 INCOMPATIBILITIES
488 None reported. Although obviously this will not work on Windows.
490 =head1 BUGS AND LIMITATIONS
492 No bugs have been reported.
494 Please report any bugs or feature requests to
495 C<bug-acme-dahut-call@rt.cpan.org>, or through the web interface at
496 L<http://rt.cpan.org>.
500 L<Proc::Daemon>, L<Daemon::Generic>
504 Chris Prather C<< <perigrin@cpan.org> >>
506 Stevan Little C<< <stevan.little@iinteractive.com> >>
510 Mike Boyko, Matt S. Trout, Stevan Little, Brandon Black, Ash Berlin and the
513 Some bug fixes sponsored by Takkle Inc.
515 =head1 LICENCE AND COPYRIGHT
517 Copyright (c) 2007, Chris Prather C<< <perigrin@cpan.org> >>. All rights
520 This module is free software; you can redistribute it and/or
521 modify it under the same terms as Perl itself. See L<perlartistic>.
523 =head1 DISCLAIMER OF WARRANTY
525 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
526 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
527 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
528 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
529 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
530 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
531 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
532 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
533 NECESSARY SERVICING, REPAIR, OR CORRECTION.
535 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
536 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
537 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
538 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
539 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
540 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
541 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
542 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
543 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF