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 - provides a Role that daemonizes your Moose based
 297 application.
 298
 299 =head1 VERSION
 300
 301 This document describes MooseX::Daemonize version 0.05
 302
 303 =head1 SYNOPSIS
 304
 305     package My::Daemon;
 306     use Moose;
 307
 308     with qw(MooseX::Daemonize);
 309
 310     # ... define your class ....
 311
 312     after start => sub {
 313         my $self = shift;
 314         return unless $self->is_daemon;
 315         # your daemon code here ...
 316     };
 317
 318     # then in your script ...
 319
 320     my $daemon = My::Daemon->new_with_options();
 321
 322     my ($command) = @{$daemon->extra_argv}
 323     defined $command || die "No command specified";
 324
 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';
 329
 330     warn($daemon->status_message);
 331     exit($daemon->exit_code);
 332
 333 =head1 DESCRIPTION
 334
 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.
 338
 339 =head1 ATTRIBUTES
 340
 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>.
 345
 346 =over
 347
 348 =item I<progname Path::Class::Dir | Str>
 349
 350 The name of our daemon, defaults to C<$package_name =~ s/::/_/>;
 351
 352 =item I<pidbase Path::Class::Dir | Str>
 353
 354 The base for our bid, defaults to C</var/run/$progname>
 355
 356 =item I<pidfile MooseX::Daemonize::Pid::File | Str>
 357
 358 The file we store our PID in, defaults to C</var/run/$progname>
 359
 360 =item I<foreground Bool>
 361
 362 If true, the process won't background. Useful for debugging. This option can
 363 be set via Getopt's -f.
 364
 365 =item I<is_daemon Bool>
 366
 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 { }>
 369 block.
 370
 371 B<NOTE:> This option is explicitly B<not> available through L<MooseX::Getopt>.
 372
 373 =item I<stop_timeout>
 374
 375 Number of seconds to wait for the process to stop, before trying harder to kill
 376 it. Defaults to 2 seconds.
 377
 378 =back
 379
 380 These are the internal attributes, which are not available through MooseX::Getopt.
 381
 382 =over 4
 383
 384 =item I<exit_code Int>
 385
 386 =item I<status_message Str>
 387
 388 =back
 389
 390 =head1 METHODS
 391
 392 =head2 Daemon Control Methods
 393
 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.
 397
 398 Extending these methods is best done with the L<Moose> method modifiers,
 399 such as C<before>, C<after> and C<around>.
 400
 401 =over 4
 402
 403 =item B<start>
 404
 405 Setup a pidfile, fork, then setup the signal handlers.
 406
 407 =item B<stop>
 408
 409 Stop the process matching the pidfile, and unlinks the pidfile.
 410
 411 =item B<restart>
 412
 413 Literally this is:
 414
 415     $self->stop();
 416     $self->start();
 417
 418 =item B<status>
 419
 420 =item B<shutdown>
 421
 422 =back
 423
 424
 425 =head2 Pidfile Handling Methods
 426
 427 =over 4
 428
 429 =item B<init_pidfile>
 430
 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>.
 433
 434 =item B<check>
 435
 436 This checks to see if the daemon process is currently running by checking
 437 the pidfile.
 438
 439 =item B<get_pid>
 440
 441 Returns the PID of the daemon process.
 442
 443 =item B<save_pid>
 444
 445 Write the pidfile.
 446
 447 =item B<remove_pid>
 448
 449 Removes the pidfile.
 450
 451 =back
 452
 453 =head2 Signal Handling Methods
 454
 455 =over 4
 456
 457 =item B<setup_signals>
 458
 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
 461 and add them.
 462
 463 =item B<handle_sigint>
 464
 465 Handle a INT signal, by default calls C<$self->stop()>
 466
 467 =item B<handle_sighup>
 468
 469 Handle a HUP signal. By default calls C<$self->restart()>
 470
 471 =back
 472
 473 =head2 Introspection
 474
 475 =over 4
 476
 477 =item meta()
 478
 479 The C<meta()> method from L<Class::MOP::Class>
 480
 481 =back
 482
 483 =head1 DEPENDENCIES
 484
 485 L<Moose>, L<MooseX::Getopt>, L<MooseX::Types::Path::Class> and L<POSIX>
 486
 487 =head1 INCOMPATIBILITIES
 488
 489 None reported. Although obviously this will not work on Windows.
 490
 491 =head1 BUGS AND LIMITATIONS
 492
 493 No bugs have been reported.
 494
 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>.
 498
 499 =head1 SEE ALSO
 500
 501 L<Proc::Daemon>, L<Daemon::Generic>
 502
 503 =head1 AUTHORS
 504
 505 Chris Prather  C<< <perigrin@cpan.org> >>
 506
 507 Stevan Little  C<< <stevan.little@iinteractive.com> >>
 508
 509 =head1 THANKS
 510
 511 Mike Boyko, Matt S. Trout, Stevan Little, Brandon Black, Ash Berlin and the
 512 #moose denzians
 513
 514 Some bug fixes sponsored by Takkle Inc.
 515
 516 =head1 LICENCE AND COPYRIGHT
 517
 518 Copyright (c) 2007, Chris Prather C<< <perigrin@cpan.org> >>. All rights
 519 reserved.
 520
 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>.
 523
 524 =head1 DISCLAIMER OF WARRANTY
 525
 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.
 535
 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
 545 SUCH DAMAGES.
 546
 547 =cut