lib/MooseX/Daemonize.pm

   1 package MooseX::Daemonize;
   2 use strict;    # because Kwalitee is pedantic
   3 use Moose::Role;
   4 use MooseX::Types::Path::Class;
   5
   6 our $VERSION = 0.05;
   7
   8 with 'MooseX::Daemonize::WithPidFile',
   9      'MooseX::Getopt';
  10
  11 use constant OK    => 0;
  12 use constant ERROR => 1;
  13
  14 has progname => (
  15     metaclass => 'Getopt',
  16     isa       => 'Str',
  17     is        => 'ro',
  18     lazy      => 1,
  19     required  => 1,
  20     default   => sub {
  21         ( my $name = lc $_[0]->meta->name ) =~ s/::/_/g;
  22         return $name;
  23     },
  24 );
  25
  26 has pidbase => (
  27     metaclass => 'Getopt',
  28     isa       => 'Path::Class::Dir',
  29     is        => 'ro',
  30     coerce    => 1,
  31     required  => 1,
  32     lazy      => 1,
  33     default   => sub { Path::Class::Dir->new('var', 'run') },
  34 );
  35
  36 has basedir => (
  37     metaclass => 'Getopt',
  38     isa       => 'Path::Class::Dir',
  39     is        => 'ro',
  40     coerce    => 1,
  41     required  => 1,
  42     lazy      => 1,
  43     default   => sub { Path::Class::Dir->new('/') },
  44 );
  45
  46 has foreground => (
  47     metaclass   => 'Getopt',
  48     cmd_aliases => 'f',
  49     isa         => 'Bool',
  50     is          => 'ro',
  51     default     => sub { 0 },
  52 );
  53
  54 has stop_timeout => (
  55     metaclass => 'Getopt',
  56     isa       => 'Int',
  57     is        => 'rw',
  58     default   => sub { 2 }
  59 );
  60
  61 # internal book-keeping
  62
  63 has status_message => (
  64     metaclass => 'NoGetopt',
  65     isa       => 'Str',
  66     is        => 'rw',
  67     clearer   => 'clear_status_message',
  68 );
  69
  70 has exit_code => (
  71     metaclass => 'NoGetopt',
  72     isa       => 'Int',
  73     is        => 'rw',
  74     clearer   => 'clear_exit_code',
  75 );
  76
  77 # methods ...
  78
  79 ## PID file related stuff ...
  80
  81 sub init_pidfile {
  82     my $self = shift;
  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 );
  86 }
  87
  88 # backwards compat,
  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        }
  93
  94 ## signal handling ...
  95
  96 sub setup_signals {
  97     my $self = shift;
  98     $SIG{'INT'} = sub { $self->shutdown };
  99 # I can't think of a sane default here really ...
 100 #    $SIG{'HUP'} = sub { $self->handle_sighup };
 101 }
 102
 103 sub shutdown {
 104     my $self = shift;
 105     $self->pidfile->remove if $self->pidfile->pid == $$;
 106     exit(0);
 107 }
 108
 109 ## daemon control methods ...
 110
 111 sub start {
 112     my $self = shift;
 113
 114     $self->clear_status_message;
 115     $self->clear_exit_code;
 116
 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);
 121     }
 122
 123     if ($self->foreground) {
 124         $self->is_daemon(1);
 125     }
 126     else {
 127         eval { $self->daemonize };
 128         if ($@) {
 129             $self->exit_code(ERROR);
 130             $self->status_message('Start failed : ' . $@);
 131             return !($self->exit_code);
 132         }
 133     }
 134
 135     unless ($self->is_daemon) {
 136         $self->exit_code(OK);
 137         $self->status_message('Start succeeded');
 138         return !($self->exit_code);
 139     }
 140
 141     $self->pidfile->pid($$);
 142
 143     # Change to basedir
 144     chdir $self->basedir;
 145
 146     $self->pidfile->write;
 147     $self->setup_signals;
 148     return $$;
 149 }
 150
 151 sub status {
 152     my $self = shift;
 153
 154     $self->clear_status_message;
 155     $self->clear_exit_code;
 156
 157     if ($self->pidfile->is_running) {
 158         $self->exit_code(OK);
 159         $self->status_message('Daemon is running with pid (' . $self->pidfile->pid . ')');
 160     }
 161     else {
 162         $self->exit_code(ERROR);
 163         $self->status_message('Daemon is not running with pid (' . $self->pidfile->pid . ')');
 164     }
 165
 166     return !($self->exit_code);
 167 }
 168
 169 sub restart {
 170     my $self = shift;
 171
 172     $self->clear_status_message;
 173     $self->clear_exit_code;
 174
 175     unless ($self->stop) {
 176         $self->exit_code(ERROR);
 177         $self->status_message('Restart (Stop) failed : ' . $@);
 178     }
 179
 180     unless ($self->start) {
 181         $self->exit_code(ERROR);
 182         $self->status_message('Restart (Start) failed : ' . $@);
 183     }
 184
 185     if ($self->exit_code == OK) {
 186         $self->exit_code(OK);
 187         $self->status_message("Restart successful");
 188     }
 189
 190     return !($self->exit_code);
 191 }
 192
 193 # Make _kill *really* private
 194 my $_kill;
 195
 196 sub stop {
 197     my $self = shift;
 198
 199     $self->clear_status_message;
 200     $self->clear_exit_code;
 201
 202     # if the pid is not running
 203     # then we dont need to stop
 204     # anything ...
 205     if ($self->pidfile->is_running) {
 206
 207         # if we are foreground, then
 208         # no need to try and kill
 209         # ourselves
 210         unless ($self->foreground) {
 211
 212             # kill the process ...
 213             eval { $self->$_kill($self->pidfile->pid) };
 214             # and complain if we can't ...
 215             if ($@) {
 216                 $self->exit_code(ERROR);
 217                 $self->status_message('Stop failed : ' . $@);
 218             }
 219             # or gloat if we succeed ..
 220             else {
 221                 $self->exit_code(OK);
 222                 $self->status_message('Stop succeeded');
 223             }
 224
 225         }
 226
 227         # clean up ...
 228         eval { $self->pidfile->remove };
 229         if ($@) {
 230             warn "Could not remove pidfile ("
 231                . $self->pidfile->file
 232                . ") because : $!";
 233         }
 234
 235     }
 236     else {
 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");
 242     }
 243
 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);
 248 }
 249
 250 $_kill = sub {
 251     my ( $self, $pid ) = @_;
 252     return unless $pid;
 253     unless ( CORE::kill 0 => $pid ) {
 254         # warn "$pid already appears dead.";
 255         return;
 256     }
 257
 258     if ( $pid eq $$ ) {
 259         die "$pid is us! Can't commit suicide.";
 260     }
 261
 262     my $timeout = $self->stop_timeout;
 263
 264     # kill 0 => $pid returns 0 if the process is dead
 265     # $!{EPERM} could also be true if we cant kill it (permission error)
 266
 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;
 271
 272         CORE::kill($signal, $pid);
 273
 274         last unless CORE::kill 0 => $pid or $!{EPERM};
 275
 276         while ($timeout) {
 277             sleep(1);
 278             last unless CORE::kill 0 => $pid or $!{EPERM};
 279             $timeout--;
 280         }
 281     }
 282
 283     return unless ( CORE::kill 0 => $pid or $!{EPERM} );
 284
 285     # IF it is still running
 286     Carp::carp "$pid doesn't seem to want to die.";     # AHH EVIL DEAD!
 287 };
 288
 289 1;
 290 __END__
 291
 292 =pod
 293
 294 =head1 NAME
 295
 296 MooseX::Daemonize - Role for daemonizing your Moose based application
 297
 298 =head1 VERSION
 299
 300 This document describes MooseX::Daemonize version 0.05
 301
 302 =head1 SYNOPSIS
 303
 304     package My::Daemon;
 305     use Moose;
 306
 307     with qw(MooseX::Daemonize);
 308
 309     # ... define your class ....
 310
 311     after start => sub {
 312         my $self = shift;
 313         return unless $self->is_daemon;
 314         # your daemon code here ...
 315     };
 316
 317     # then in your script ...
 318
 319     my $daemon = My::Daemon->new_with_options();
 320
 321     my ($command) = @{$daemon->extra_argv}
 322     defined $command || die "No command specified";
 323
 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';
 328
 329     warn($daemon->status_message);
 330     exit($daemon->exit_code);
 331
 332 =head1 DESCRIPTION
 333
 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.
 337
 338 =head1 ATTRIBUTES
 339
 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>.
 344
 345 =over
 346
 347 =item I<progname Path::Class::Dir | Str>
 348
 349 The name of our daemon, defaults to C<$package_name =~ s/::/_/>;
 350
 351 =item I<pidbase Path::Class::Dir | Str>
 352
 353 The base for our bid, defaults to C</var/run/$progname>
 354
 355 =item I<pidfile MooseX::Daemonize::Pid::File | Str>
 356
 357 The file we store our PID in, defaults to C</var/run/$progname>
 358
 359 =item I<foreground Bool>
 360
 361 If true, the process won't background. Useful for debugging. This option can
 362 be set via Getopt's -f.
 363
 364 =item I<is_daemon Bool>
 365
 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 { }>
 368 block.
 369
 370 B<NOTE:> This option is explicitly B<not> available through L<MooseX::Getopt>.
 371
 372 =item I<stop_timeout>
 373
 374 Number of seconds to wait for the process to stop, before trying harder to kill
 375 it. Defaults to 2 seconds.
 376
 377 =back
 378
 379 These are the internal attributes, which are not available through MooseX::Getopt.
 380
 381 =over 4
 382
 383 =item I<exit_code Int>
 384
 385 =item I<status_message Str>
 386
 387 =back
 388
 389 =head1 METHODS
 390
 391 =head2 Daemon Control Methods
 392
 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.
 396
 397 Extending these methods is best done with the L<Moose> method modifiers,
 398 such as C<before>, C<after> and C<around>.
 399
 400 =over 4
 401
 402 =item B<start>
 403
 404 Setup a pidfile, fork, then setup the signal handlers.
 405
 406 =item B<stop>
 407
 408 Stop the process matching the pidfile, and unlinks the pidfile.
 409
 410 =item B<restart>
 411
 412 Literally this is:
 413
 414     $self->stop();
 415     $self->start();
 416
 417 =item B<status>
 418
 419 =item B<shutdown>
 420
 421 =back
 422
 423
 424 =head2 Pidfile Handling Methods
 425
 426 =over 4
 427
 428 =item B<init_pidfile>
 429
 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>.
 432
 433 =item B<check>
 434
 435 This checks to see if the daemon process is currently running by checking
 436 the pidfile.
 437
 438 =item B<get_pid>
 439
 440 Returns the PID of the daemon process.
 441
 442 =item B<save_pid>
 443
 444 Write the pidfile.
 445
 446 =item B<remove_pid>
 447
 448 Removes the pidfile.
 449
 450 =back
 451
 452 =head2 Signal Handling Methods
 453
 454 =over 4
 455
 456 =item B<setup_signals>
 457
 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
 460 and add them.
 461
 462 =item B<handle_sigint>
 463
 464 Handle a INT signal, by default calls C<$self->stop()>
 465
 466 =item B<handle_sighup>
 467
 468 Handle a HUP signal. By default calls C<$self->restart()>
 469
 470 =back
 471
 472 =head2 Introspection
 473
 474 =over 4
 475
 476 =item meta()
 477
 478 The C<meta()> method from L<Class::MOP::Class>
 479
 480 =back
 481
 482 =head1 DEPENDENCIES
 483
 484 L<Moose>, L<MooseX::Getopt>, L<MooseX::Types::Path::Class> and L<POSIX>
 485
 486 =head1 INCOMPATIBILITIES
 487
 488 None reported. Although obviously this will not work on Windows.
 489
 490 =head1 BUGS AND LIMITATIONS
 491
 492 No bugs have been reported.
 493
 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>.
 497
 498 =head1 SEE ALSO
 499
 500 L<Proc::Daemon>, L<Daemon::Generic>
 501
 502 =head1 AUTHORS
 503
 504 Chris Prather  C<< <perigrin@cpan.org> >>
 505
 506 Stevan Little  C<< <stevan.little@iinteractive.com> >>
 507
 508 =head1 THANKS
 509
 510 Mike Boyko, Matt S. Trout, Stevan Little, Brandon Black, Ash Berlin and the
 511 #moose denzians
 512
 513 Some bug fixes sponsored by Takkle Inc.
 514
 515 =head1 LICENCE AND COPYRIGHT
 516
 517 Copyright (c) 2007, Chris Prather C<< <perigrin@cpan.org> >>. All rights
 518 reserved.
 519
 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>.
 522
 523 =head1 DISCLAIMER OF WARRANTY
 524
 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.
 534
 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
 544 SUCH DAMAGES.
 545
 546 =cut