1 package MooseX::Daemonize;
2 use strict; # because Kwalitee is pedantic
4 use MooseX::Types::Path::Class;
5 use File::Path qw(make_path);
9 with 'MooseX::Daemonize::WithPidFile',
16 metaclass => 'Getopt',
22 ( my $name = lc $_[0]->meta->name ) =~ s/::/_/g;
28 metaclass => 'Getopt',
29 isa => 'Path::Class::Dir',
34 default => sub { Path::Class::Dir->new('', 'var', 'run') },
38 metaclass => 'Getopt',
39 isa => 'Path::Class::Dir',
44 default => sub { Path::Class::Dir->new('/') },
48 metaclass => 'Getopt',
56 metaclass => 'Getopt',
62 # internal book-keeping
64 has status_message => (
65 metaclass => 'NoGetopt',
68 clearer => 'clear_status_message',
72 metaclass => 'NoGetopt',
75 clearer => 'clear_exit_code',
80 ## PID file related stuff ...
84 my $file = $self->pidbase . '/' . $self->progname . '.pid';
86 if ( !-d $self->pidbase ) {
87 make_path( $self->pidbase, { error => \my $err } );
89 confess sprintf( "Cannot create pidbase directory '%s': %s",
90 $self->pidbase, @$err );
94 confess "Cannot write to $file" unless (-e $file ? -w $file : -w $self->pidbase);
95 MooseX::Daemonize::Pid::File->new( file => $file );
99 sub check { (shift)->pidfile->is_running }
100 sub save_pid { (shift)->pidfile->write }
101 sub remove_pid { (shift)->pidfile->remove }
102 sub get_pid { (shift)->pidfile->pid }
104 ## signal handling ...
108 $SIG{'INT'} = sub { $self->shutdown };
109 # I can't think of a sane default here really ...
110 # $SIG{'HUP'} = sub { $self->handle_sighup };
115 $self->pidfile->remove if $self->pidfile->pid == $$;
119 ## daemon control methods ...
124 $self->clear_status_message;
125 $self->clear_exit_code;
127 if ($self->pidfile->is_running) {
128 $self->exit_code($self->OK);
129 $self->status_message('Daemon is already running with pid (' . $self->pidfile->pid . ')');
130 return !($self->exit_code);
133 if ($self->foreground) {
137 eval { $self->daemonize };
139 $self->exit_code($self->ERROR);
140 $self->status_message('Start failed : ' . $@);
141 return !($self->exit_code);
145 unless ($self->is_daemon) {
146 $self->exit_code($self->OK);
147 $self->status_message('Start succeeded');
148 return !($self->exit_code);
151 $self->pidfile->pid($$);
154 chdir $self->basedir;
156 $self->pidfile->write;
157 $self->setup_signals;
164 $self->clear_status_message;
165 $self->clear_exit_code;
167 if ($self->pidfile->is_running) {
168 $self->exit_code($self->OK);
169 $self->status_message('Daemon is running with pid (' . $self->pidfile->pid . ')');
172 $self->exit_code($self->ERROR);
173 $self->status_message('Daemon is not running with pid (' . $self->pidfile->pid . ')');
176 return !($self->exit_code);
182 $self->clear_status_message;
183 $self->clear_exit_code;
185 unless ($self->stop) {
186 $self->exit_code($self->ERROR);
187 $self->status_message('Restart (Stop) failed : ' . $@);
190 unless ($self->start) {
191 $self->exit_code($self->ERROR);
192 $self->status_message('Restart (Start) failed : ' . $@);
195 if ($self->exit_code == $self->OK) {
196 $self->exit_code($self->OK);
197 $self->status_message("Restart successful");
200 return !($self->exit_code);
203 # Make _kill *really* private
209 $self->clear_status_message;
210 $self->clear_exit_code;
212 # if the pid is not running
213 # then we dont need to stop
215 if ($self->pidfile->is_running) {
217 # if we are foreground, then
218 # no need to try and kill
220 unless ($self->foreground) {
222 # kill the process ...
223 eval { $self->$_kill($self->pidfile->pid) };
224 # and complain if we can't ...
226 $self->exit_code($self->ERROR);
227 $self->status_message('Stop failed : ' . $@);
229 # or gloat if we succeed ..
231 $self->exit_code($self->OK);
232 $self->status_message('Stop succeeded');
238 # this just returns the OK
239 # exit code for now, but
240 # we should make this overridable
241 $self->exit_code($self->OK);
242 $self->status_message("Not running");
245 # if we are returning to our script
246 # then we actually need the opposite
247 # of what the system/OS expects
248 return !($self->exit_code);
252 my ( $self, $pid ) = @_;
254 unless ( CORE::kill 0 => $pid ) {
255 # warn "$pid already appears dead.";
260 die "$pid is us! Can't commit suicide.";
263 my $timeout = $self->stop_timeout;
265 # kill 0 => $pid returns 0 if the process is dead
266 # $!{EPERM} could also be true if we cant kill it (permission error)
268 # Try SIGINT ... 2s ... SIGTERM ... 2s ... SIGKILL ... 3s ... UNDEAD!
269 my $terminating_signal;
270 for ( [ 2, $timeout ], [15, $timeout], [9, $timeout * 1.5] ) {
271 my ($signal, $timeout) = @$_;
272 $timeout = int $timeout;
274 CORE::kill($signal, $pid);
277 unless(CORE::kill 0 => $pid or $!{EPERM}) {
278 $terminating_signal = $signal;
282 sleep(1) if $timeout;
285 last if $terminating_signal;
288 if($terminating_signal) {
289 if($terminating_signal == 9) {
290 # clean up the pidfile ourselves iff we used -9 and it worked
291 warn "Had to resort to 'kill -9' and it worked, wiping pidfile";
292 eval { $self->pidfile->remove };
294 warn "Could not remove pidfile ("
295 . $self->pidfile->file
302 # IF it is still running
303 Carp::carp "$pid doesn't seem to want to die."; # AHH EVIL DEAD!
313 MooseX::Daemonize - Role for daemonizing your Moose based application
317 This document describes MooseX::Daemonize version 0.15
321 The maintainers of this module now recommend using L<Daemon::Control> instead.
328 with qw(MooseX::Daemonize);
330 # ... define your class ....
334 return unless $self->is_daemon;
335 # your daemon code here ...
338 # then in your script ...
340 my $daemon = My::Daemon->new_with_options();
342 my ($command) = @{$daemon->extra_argv}
343 defined $command || die "No command specified";
345 $daemon->start if $command eq 'start';
346 $daemon->status if $command eq 'status';
347 $daemon->restart if $command eq 'restart';
348 $daemon->stop if $command eq 'stop';
350 warn($daemon->status_message);
351 exit($daemon->exit_code);
355 Often you want to write a persistant daemon that has a pid file, and responds
356 appropriately to Signals. This module provides a set of basic roles as an
357 infrastructure to do that.
361 When going into background MooseX::Daemonize closes all open file
362 handles. This may interfere with you logging because it may also close the log
363 file handle you want to write to. To prevent this you can either defer opening
364 the log file until after start. Alternatively, use can use the
365 'dont_close_all_files' option either from the command line or in your .sh
368 Assuming you want to use Log::Log4perl for example you could expand the
369 MooseX::Daemonize example above like this.
373 return unless $self->is_daemon;
374 Log::Log4perl->init(\$log4perl_config);
375 my $logger = Log::Log4perl->get_logger();
376 $logger->info("Daemon started");
377 # your daemon code here ...
383 This list includes attributes brought in from other roles as well
384 we include them here for ease of documentation. All of these attributes
385 are settable though L<MooseX::Getopt>'s command line handling, with the
386 exception of C<is_daemon>.
390 =item I<progname Path::Class::Dir | Str>
392 The name of our daemon, defaults to C<$package_name =~ s/::/_/>;
394 =item I<pidbase Path::Class::Dir | Str>
396 The base for our PID, defaults to C</var/run/>
398 =item I<basedir Path::Class::Dir | Str>
400 The directory we chdir to; defaults to C</>.
402 =item I<pidfile MooseX::Daemonize::Pid::File | Str>
404 The file we store our PID in, defaults to C<$pidbase/$progname.pid>
406 =item I<foreground Bool>
408 If true, the process won't background. Useful for debugging. This option can
409 be set via Getopt's -f.
411 =item I<no_double_fork Bool>
413 If true, the process will not perform the typical double-fork, which is extra
414 added protection from your process accidentally aquiring a controlling terminal.
415 More information can be found by Googling "double fork daemonize".
417 =item I<ignore_zombies Bool>
419 If true, the process will not clean up zombie processes.
420 Normally you don't want this.
422 =item I<dont_close_all_files Bool>
424 If true, the objects open filehandles will not be closed when daemonized.
425 Normally you don't want this.
428 =item I<is_daemon Bool>
430 If true, the process is the backgrounded daemon process, if false it is the
431 parent process. This is useful for example in an C<after 'start' => sub { }>
434 B<NOTE:> This option is explicitly B<not> available through L<MooseX::Getopt>.
436 =item I<stop_timeout>
438 Number of seconds to wait for the process to stop, before trying harder to kill
439 it. Defaults to 2 seconds.
443 These are the internal attributes, which are not available through MooseX::Getopt.
447 =item I<exit_code Int>
449 =item I<status_message Str>
455 =head2 Daemon Control Methods
457 These methods can be used to control the daemon behavior. Every effort
458 has been made to have these methods DWIM (Do What I Mean), so that you
459 can focus on just writing the code for your daemon.
461 Extending these methods is best done with the L<Moose> method modifiers,
462 such as C<before>, C<after> and C<around>.
468 Setup a pidfile, fork, then setup the signal handlers.
472 Stop the process matching the pidfile, and unlinks the pidfile.
488 =head2 Pidfile Handling Methods
492 =item B<init_pidfile>
494 This method will create a L<MooseX::Daemonize::Pid::File> object and tell
495 it to store the PID in the file C<$pidbase/$progname.pid>.
499 This checks to see if the daemon process is currently running by checking
504 Returns the PID of the daemon process.
516 =head2 Signal Handling Methods
520 =item B<setup_signals>
522 Setup the signal handlers, by default it only sets up handlers for SIGINT and
523 SIGHUP. If you wish to add more signals just use the C<after> method modifier
526 =item B<handle_sigint>
528 Handle a INT signal, by default calls C<$self->stop()>
530 =item B<handle_sighup>
532 Handle a HUP signal. By default calls C<$self->restart()>
536 =head2 Exit Code Methods
538 These are overriable constant methods used for setting the exit code.
558 The C<meta()> method from L<Class::MOP::Class>
564 L<Moose>, L<MooseX::Getopt>, L<MooseX::Types::Path::Class> and L<POSIX>
566 =head1 INCOMPATIBILITIES
568 None reported. Although obviously this will not work on Windows.
570 =head1 BUGS AND LIMITATIONS
572 No bugs have been reported.
574 Please report any bugs or feature requests to
575 C<bug-acme-dahut-call@rt.cpan.org>, or through the web interface at
576 L<http://rt.cpan.org>.
580 L<Daemon::Control>, L<Proc::Daemon>, L<Daemon::Generic>
584 Chris Prather C<< <chris@prather.org >>
586 Stevan Little C<< <stevan.little@iinteractive.com> >>
590 Mike Boyko, Matt S. Trout, Stevan Little, Brandon Black, Ash Berlin and the
593 Some bug fixes sponsored by Takkle Inc.
595 =head1 LICENCE AND COPYRIGHT
597 Copyright (c) 2007-2011, Chris Prather C<< <chris@prather.org> >>. Some rights
600 This module is free software; you can redistribute it and/or
601 modify it under the same terms as Perl itself. See L<perlartistic>.
603 =head1 DISCLAIMER OF WARRANTY
605 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
606 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
607 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
608 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
609 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
610 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
611 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
612 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
613 NECESSARY SERVICING, REPAIR, OR CORRECTION.
615 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
616 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
617 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
618 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
619 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
620 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
621 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
622 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
623 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF