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 has progname => (
  12     metaclass => 'Getopt',
  13     isa       => 'Str',
  14     is        => 'ro',
  15     lazy      => 1,
  16     required  => 1,
  17     default   => sub {
  18         ( my $name = lc $_[0]->meta->name ) =~ s/::/_/g;
  19         return $name;
  20     },
  21 );
  22
  23 has pidbase => (
  24     metaclass => 'Getopt',
  25     isa       => 'Path::Class::Dir',
  26     is        => 'ro',
  27     coerce    => 1,
  28     required  => 1,
  29     lazy      => 1,
  30     default   => sub { Path::Class::Dir->new('var', 'run') },
  31 );
  32
  33 has basedir => (
  34     metaclass => 'Getopt',
  35     isa       => 'Path::Class::Dir',
  36     is        => 'ro',
  37     coerce    => 1,
  38     required  => 1,
  39     lazy      => 1,
  40     default   => sub { Path::Class::Dir->new('/') },
  41 );
  42
  43 has foreground => (
  44     metaclass   => 'Getopt',
  45     cmd_aliases => 'f',
  46     isa         => 'Bool',
  47     is          => 'ro',
  48     default     => sub { 0 },
  49 );
  50
  51 has stop_timeout => (
  52     metaclass => 'Getopt',
  53     isa       => 'Int',
  54     is        => 'rw',
  55     default   => sub { 2 }
  56 );
  57
  58 # internal book-keeping
  59
  60 has status_message => (
  61     metaclass => 'NoGetopt',
  62     isa       => 'Str',
  63     is        => 'rw',
  64     clearer   => 'clear_status_message',
  65 );
  66
  67 has exit_code => (
  68     metaclass => 'NoGetopt',
  69     isa       => 'Int',
  70     is        => 'rw',
  71     clearer   => 'clear_exit_code',
  72 );
  73
  74 # methods ...
  75
  76 ## PID file related stuff ...
  77
  78 sub init_pidfile {
  79     my $self = shift;
  80     my $file = $self->pidbase . '/' . $self->progname . '.pid';
  81     confess "Cannot write to $file" unless (-e $file ? -w $file : -w $self->pidbase);
  82     MooseX::Daemonize::Pid::File->new( file => $file );
  83 }
  84
  85 # backwards compat,
  86 sub check      { (shift)->pidfile->is_running }
  87 sub save_pid   { (shift)->pidfile->write      }
  88 sub remove_pid { (shift)->pidfile->remove     }
  89 sub get_pid    { (shift)->pidfile->pid        }
  90
  91 ## signal handling ...
  92
  93 sub setup_signals {
  94     my $self = shift;
  95     $SIG{'INT'} = sub { $self->shutdown };
  96 # I can't think of a sane default here really ...
  97 #    $SIG{'HUP'} = sub { $self->handle_sighup };
  98 }
  99
 100 sub shutdown {
 101     my $self = shift;
 102     $self->pidfile->remove if $self->pidfile->pid == $$;
 103     exit(0);
 104 }
 105
 106 ## daemon control methods ...
 107
 108 sub start {
 109     my $self = shift;
 110
 111     $self->clear_status_message;
 112     $self->clear_exit_code;
 113
 114     if ($self->pidfile->is_running) {
 115         $self->status_message('Daemon is already running with pid (' . $self->pidfile->pid . ')');
 116         return !($self->exit_code);
 117     }
 118
 119     if ($self->foreground) {
 120         $self->is_daemon(1);
 121     }
 122     else {
 123         eval { $self->daemonize };
 124         if ($@) {
 125             $self->exit_code(1);
 126             $self->status_message('Start failed : ' . $@);
 127             return !($self->exit_code);
 128         }
 129     }
 130
 131     unless ($self->is_daemon) {
 132         $self->status_message('Start succeeded');
 133         return !($self->exit_code);
 134     }
 135
 136     $self->pidfile->pid($$);
 137
 138     # Change to basedir
 139     chdir $self->basedir;
 140
 141     $self->pidfile->write;
 142     $self->setup_signals;
 143     return $$;
 144 }
 145
 146 sub status {
 147     my $self = shift;
 148
 149     $self->clear_status_message;
 150     $self->clear_exit_code;
 151
 152     if ($self->pidfile->is_running) {
 153         $self->status_message('Daemon is running with pid (' . $self->pidfile->pid . ')');
 154     }
 155     else {
 156         $self->exit_code(1);
 157         $self->status_message('Daemon is not running with pid (' . $self->pidfile->pid . ')');
 158     }
 159
 160     return !($self->exit_code);
 161 }
 162
 163 sub restart {
 164     my $self = shift;
 165
 166     $self->clear_status_message;
 167     $self->clear_exit_code;
 168
 169     unless ($self->stop) {
 170         $self->exit_code(1);
 171         $self->status_message('Restart (Stop) failed : ' . $@);
 172     }
 173
 174     unless ($self->start) {
 175         $self->exit_code(1);
 176         $self->status_message('Restart (Start) failed : ' . $@);
 177     }
 178
 179     $self->status_message("Restart successful")
 180         if !$self->exit_code;
 181
 182     return !($self->exit_code);
 183 }
 184
 185 # Make _kill *really* private
 186 my $_kill;
 187
 188 sub stop {
 189     my $self = shift;
 190
 191     $self->clear_status_message;
 192     $self->clear_exit_code;
 193
 194     # if the pid is not running
 195     # then we dont need to stop
 196     # anything ...
 197     if ($self->pidfile->is_running) {
 198
 199         # if we are foreground, then
 200         # no need to try and kill
 201         # ourselves
 202         unless ($self->foreground) {
 203
 204             # kill the process ...
 205             eval { $self->$_kill($self->pidfile->pid) };
 206             # and complain if we can't ...
 207             if ($@) {
 208                 $self->exit_code(1);
 209                 $self->status_message('Stop failed : ' . $@);
 210             }
 211             # or gloat if we succeed ..
 212             else {
 213                 $self->status_message('Stop succeeded');
 214             }
 215
 216         }
 217
 218         # clean up ...
 219         eval { $self->pidfile->remove };
 220         if ($@) {
 221             warn "Could not remove pidfile ("
 222                . $self->pidfile->file
 223                . ") because : $!";
 224         }
 225
 226     }
 227     else {
 228         # this just returns the OK
 229         # exit code for now, but
 230         # we should make this overridable
 231         $self->status_message("Not running");
 232     }
 233
 234     # if we are returning to our script
 235     # then we actually need the opposite
 236     # of what the system/OS expects
 237     return !($self->exit_code);
 238 }
 239
 240 $_kill = sub {
 241     my ( $self, $pid ) = @_;
 242     return unless $pid;
 243     unless ( CORE::kill 0 => $pid ) {
 244         # warn "$pid already appears dead.";
 245         return;
 246     }
 247
 248     if ( $pid eq $$ ) {
 249         die "$pid is us! Can't commit suicide.";
 250     }
 251
 252     my $timeout = $self->stop_timeout;
 253
 254     # kill 0 => $pid returns 0 if the process is dead
 255     # $!{EPERM} could also be true if we cant kill it (permission error)
 256
 257     # Try SIGINT ... 2s ... SIGTERM ... 2s ... SIGKILL ... 3s ... UNDEAD!
 258     for ( [ 2, $timeout ], [15, $timeout], [9, $timeout * 1.5] ) {
 259         my ($signal, $timeout) = @$_;
 260         $timeout = int $timeout;
 261
 262         CORE::kill($signal, $pid);
 263
 264         last unless CORE::kill 0 => $pid or $!{EPERM};
 265
 266         while ($timeout) {
 267             sleep(1);
 268             last unless CORE::kill 0 => $pid or $!{EPERM};
 269             $timeout--;
 270         }
 271     }
 272
 273     return unless ( CORE::kill 0 => $pid or $!{EPERM} );
 274
 275     # IF it is still running
 276     Carp::carp "$pid doesn't seem to want to die.";     # AHH EVIL DEAD!
 277 };
 278
 279 1;
 280 __END__
 281
 282 =pod
 283
 284 =head1 NAME
 285
 286 MooseX::Daemonize - provides a Role that daemonizes your Moose based
 287 application.
 288
 289 =head1 VERSION
 290
 291 This document describes MooseX::Daemonize version 0.05
 292
 293 =head1 SYNOPSIS
 294
 295     package My::Daemon;
 296     use Moose;
 297
 298     with qw(MooseX::Daemonize);
 299
 300     # ... define your class ....
 301
 302     after start => sub {
 303         my $self = shift;
 304         return unless $self->is_daemon;
 305         # your daemon code here ...
 306     };
 307
 308     # then in your script ...
 309
 310     my $daemon = My::Daemon->new_with_options();
 311
 312     my ($command) = @{$daemon->extra_argv}
 313     defined $command || die "No command specified";
 314
 315     $daemon->start   if $command eq 'start';
 316     $daemon->status  if $command eq 'status';
 317     $daemon->restart if $command eq 'restart';
 318     $daemon->stop    if $command eq 'stop';
 319
 320     warn($daemon->status);
 321     exit($daemon->exit_code);
 322
 323 =head1 DESCRIPTION
 324
 325 Often you want to write a persistant daemon that has a pid file, and responds
 326 appropriately to Signals. This module provides a set of basic roles as an
 327 infrastructure to do that.
 328
 329 =head1 ATTRIBUTES
 330
 331 This list includes attributes brought in from other roles as well
 332 we include them here for ease of documentation. All of these attributes
 333 are settable though L<MooseX::Getopt>'s command line handling, with the
 334 exception of C<is_daemon>.
 335
 336 =over
 337
 338 =item I<progname Path::Class::Dir | Str>
 339
 340 The name of our daemon, defaults to C<$package_name =~ s/::/_/>;
 341
 342 =item I<pidbase Path::Class::Dir | Str>
 343
 344 The base for our bid, defaults to C</var/run/$progname>
 345
 346 =item I<pidfile MooseX::Daemonize::Pid::File | Str>
 347
 348 The file we store our PID in, defaults to C</var/run/$progname>
 349
 350 =item I<foreground Bool>
 351
 352 If true, the process won't background. Useful for debugging. This option can
 353 be set via Getopt's -f.
 354
 355 =item I<is_daemon Bool>
 356
 357 If true, the process is the backgrounded daemon process, if false it is the
 358 parent process. This is useful for example in an C<after 'start' => sub { }>
 359 block.
 360
 361 B<NOTE:> This option is explicitly B<not> available through L<MooseX::Getopt>.
 362
 363 =item I<stop_timeout>
 364
 365 Number of seconds to wait for the process to stop, before trying harder to kill
 366 it. Defaults to 2 seconds.
 367
 368 =back
 369
 370 These are the internal attributes, which are not available through MooseX::Getopt.
 371
 372 =over 4
 373
 374 =item I<exit_code Int>
 375
 376 =item I<status Str>
 377
 378 =back
 379
 380 =head1 METHODS
 381
 382 =head2 Daemon Control Methods
 383
 384 These methods can be used to control the daemon behavior. Every effort
 385 has been made to have these methods DWIM (Do What I Mean), so that you
 386 can focus on just writing the code for your daemon.
 387
 388 Extending these methods is best done with the L<Moose> method modifiers,
 389 such as C<before>, C<after> and C<around>.
 390
 391 =over 4
 392
 393 =item B<start>
 394
 395 Setup a pidfile, fork, then setup the signal handlers.
 396
 397 =item B<stop>
 398
 399 Stop the process matching the pidfile, and unlinks the pidfile.
 400
 401 =item B<restart>
 402
 403 Literally this is:
 404
 405     $self->stop();
 406     $self->start();
 407
 408 =item B<status>
 409
 410 =back
 411
 412
 413 =head2 Pidfile Handling Methods
 414
 415 =over 4
 416
 417 =item B<init_pidfile>
 418
 419 This method will create a L<MooseX::Daemonize::Pid::File> object and tell
 420 it to store the PID in the file C<$pidbase/$progname.pid>.
 421
 422 =item B<check>
 423
 424 This checks to see if the daemon process is currently running by checking
 425 the pidfile.
 426
 427 =item B<get_pid>
 428
 429 Returns the PID of the daemon process.
 430
 431 =item B<save_pid>
 432
 433 Write the pidfile.
 434
 435 =item B<remove_pid>
 436
 437 Removes the pidfile.
 438
 439 =back
 440
 441 =head2 Signal Handling Methods
 442
 443 =over 4
 444
 445 =item B<setup_signals>
 446
 447 Setup the signal handlers, by default it only sets up handlers for SIGINT and
 448 SIGHUP. If you wish to add more signals just use the C<after> method modifier
 449 and add them.
 450
 451 =item B<handle_sigint>
 452
 453 Handle a INT signal, by default calls C<$self->stop()>
 454
 455 =item B<handle_sighup>
 456
 457 Handle a HUP signal. By default calls C<$self->restart()>
 458
 459 =back
 460
 461 =head2 Introspection
 462
 463 =over 4
 464
 465 =item meta()
 466
 467 The C<meta()> method from L<Class::MOP::Class>
 468
 469 =back
 470
 471 =head1 DEPENDENCIES
 472
 473 L<Moose>, L<MooseX::Getopt>, L<MooseX::Types::Path::Class> and L<POSIX>
 474
 475 =head1 INCOMPATIBILITIES
 476
 477 None reported. Although obviously this will not work on Windows.
 478
 479 =head1 BUGS AND LIMITATIONS
 480
 481 No bugs have been reported.
 482
 483 Please report any bugs or feature requests to
 484 C<bug-acme-dahut-call@rt.cpan.org>, or through the web interface at
 485 L<http://rt.cpan.org>.
 486
 487 =head1 SEE ALSO
 488
 489 L<Proc::Daemon>, L<Daemon::Generic>
 490
 491 =head1 AUTHOR
 492
 493 Chris Prather  C<< <perigrin@cpan.org> >>
 494
 495 =head1 THANKS
 496
 497 Mike Boyko, Matt S. Trout, Stevan Little, Brandon Black, Ash Berlin and the
 498 #moose denzians
 499
 500 Some bug fixes sponsored by Takkle Inc.
 501
 502 =head1 LICENCE AND COPYRIGHT
 503
 504 Copyright (c) 2007, Chris Prather C<< <perigrin@cpan.org> >>. All rights
 505 reserved.
 506
 507 This module is free software; you can redistribute it and/or
 508 modify it under the same terms as Perl itself. See L<perlartistic>.
 509
 510 =head1 DISCLAIMER OF WARRANTY
 511
 512 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
 513 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
 514 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
 515 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
 516 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 517 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
 518 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
 519 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
 520 NECESSARY SERVICING, REPAIR, OR CORRECTION.
 521
 522 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
 523 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
 524 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
 525 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
 526 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
 527 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
 528 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
 529 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
 530 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
 531 SUCH DAMAGES.
 532
 533 =cut