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 # methods ...
  59
  60 ## PID file related stuff ...
  61
  62 sub init_pidfile {
  63     my $self = shift;
  64     my $file = $self->pidbase . '/' . $self->progname . '.pid';
  65     confess "Cannot write to $file" unless (-e $file ? -w $file : -w $self->pidbase);
  66     MooseX::Daemonize::Pid::File->new( file => $file );
  67 }
  68
  69 # backwards compat,
  70 sub check      { (shift)->pidfile->is_running }
  71 sub save_pid   { (shift)->pidfile->write      }
  72 sub remove_pid { (shift)->pidfile->remove     }
  73 sub get_pid    { (shift)->pidfile->pid        }
  74
  75 ## signal handling ...
  76
  77 sub setup_signals {
  78     my $self = shift;
  79     $SIG{'INT'} = sub { $self->handle_sigint };
  80     $SIG{'HUP'} = sub { $self->handle_sighup };
  81 }
  82
  83 sub handle_sigint { $_[0]->stop; }
  84 sub handle_sighup { $_[0]->restart; }
  85
  86 ## daemon control methods ...
  87
  88 sub start {
  89     my ($self) = @_;
  90
  91     confess "instance already running" if $self->pidfile->is_running;
  92
  93     $self->daemonize unless $self->foreground;
  94
  95     return unless $self->is_daemon;
  96
  97     $self->pidfile->pid($$);
  98
  99     # Change to basedir
 100     chdir $self->basedir;
 101
 102     $self->pidfile->write;
 103     $self->setup_signals;
 104     return $$;
 105 }
 106
 107 sub restart {
 108     my ($self) = @_;
 109     $self->stop( no_exit => 1 );
 110     $self->start();
 111 }
 112
 113 # Make _kill *really* private
 114 my $_kill;
 115
 116 sub stop {
 117     my ( $self, %args ) = @_;
 118     my $pid = $self->pidfile->pid;
 119     $self->$_kill($pid) unless $self->foreground();
 120     $self->pidfile->remove;
 121     return 1 if $args{no_exit};
 122     exit;
 123 }
 124
 125 $_kill = sub {
 126     my ( $self, $pid ) = @_;
 127     return unless $pid;
 128     unless ( CORE::kill 0 => $pid ) {
 129
 130         # warn "$pid already appears dead.";
 131         return;
 132     }
 133
 134     if ( $pid eq $$ ) {
 135
 136         # warn "$pid is us! Can't commit suicide.";
 137         return;
 138     }
 139
 140     my $timeout = $self->stop_timeout;
 141
 142     # kill 0 => $pid returns 0 if the process is dead
 143     # $!{EPERM} could also be true if we cant kill it (permission error)
 144
 145     # Try SIGINT ... 2s ... SIGTERM ... 2s ... SIGKILL ... 3s ... UNDEAD!
 146     for ( [ 2, $timeout ], [15, $timeout], [9, $timeout * 1.5] ) {
 147         my ($signal, $timeout) = @$_;
 148         $timeout = int $timeout;
 149
 150         CORE::kill($signal, $pid);
 151
 152         last unless CORE::kill 0 => $pid or $!{EPERM};
 153
 154         while ($timeout) {
 155             sleep(1);
 156             last unless CORE::kill 0 => $pid or $!{EPERM};
 157             $timeout--;
 158         }
 159     }
 160
 161     return unless ( CORE::kill 0 => $pid or $!{EPERM} );
 162
 163     # IF it is still running
 164     Carp::carp "$pid doesn't seem to want to die.";     # AHH EVIL DEAD!
 165 };
 166
 167 1;
 168 __END__
 169
 170 =pod
 171
 172 =head1 NAME
 173
 174 MooseX::Daemonize - provides a Role that daemonizes your Moose based
 175 application.
 176
 177 =head1 VERSION
 178
 179 This document describes MooseX::Daemonize version 0.05
 180
 181 =head1 SYNOPSIS
 182
 183     package My::Daemon;
 184     use Moose;
 185
 186     with qw(MooseX::Daemonize);
 187
 188     # ... define your class ....
 189
 190     after start => sub {
 191         my $self = shift;
 192         return unless $self->is_daemon;
 193         # your daemon code here ...
 194     };
 195
 196     # then in your script ...
 197
 198     my $daemon = My::Daemon->new_with_options();
 199
 200     my ($command) = @{$daemon->extra_argv}
 201     defined $command || die "No command specified";
 202
 203     $daemon->start() if $command eq 'start';
 204     $daemon->stop()  if $command eq 'stop';
 205
 206 =head1 DESCRIPTION
 207
 208 Often you want to write a persistant daemon that has a pid file, and responds
 209 appropriately to Signals. This module provides a set of basic roles as an
 210 infrastructure to do that.
 211
 212 =head1 ATTRIBUTES
 213
 214 This list includes attributes brought in from other roles as well
 215 we include them here for ease of documentation. All of these attributes
 216 are settable though L<MooseX::Getopt>'s command line handling, with the
 217 exception of C<is_daemon>.
 218
 219 =over
 220
 221 =item I<progname Path::Class::Dir | Str>
 222
 223 The name of our daemon, defaults to C<$package_name =~ s/::/_/>;
 224
 225 =item I<pidbase Path::Class::Dir | Str>
 226
 227 The base for our bid, defaults to C</var/run/$progname>
 228
 229 =item I<pidfile MooseX::Daemonize::Pid::File | Str>
 230
 231 The file we store our PID in, defaults to C</var/run/$progname>
 232
 233 =item I<foreground Bool>
 234
 235 If true, the process won't background. Useful for debugging. This option can
 236 be set via Getopt's -f.
 237
 238 =item I<is_daemon Bool>
 239
 240 If true, the process is the backgrounded daemon process, if false it is the
 241 parent process. This is useful for example in an C<after 'start' => sub { }>
 242 block.
 243
 244 B<NOTE:> This option is explicitly B<not> available through L<MooseX::Getopt>.
 245
 246 =item I<stop_timeout>
 247
 248 Number of seconds to wait for the process to stop, before trying harder to kill
 249 it. Defaults to 2 seconds.
 250
 251 =back
 252
 253 =head1 METHODS
 254
 255 =head2 Daemon Control Methods
 256
 257 These methods can be used to control the daemon behavior. Every effort
 258 has been made to have these methods DWIM (Do What I Mean), so that you
 259 can focus on just writing the code for your daemon.
 260
 261 Extending these methods is best done with the L<Moose> method modifiers,
 262 such as C<before>, C<after> and C<around>.
 263
 264 =over 4
 265
 266 =item B<start>
 267
 268 Setup a pidfile, fork, then setup the signal handlers.
 269
 270 =item B<stop>
 271
 272 Stop the process matching the pidfile, and unlinks the pidfile.
 273
 274 =item B<restart>
 275
 276 Literally this is:
 277
 278     $self->stop();
 279     $self->start();
 280
 281 =back
 282
 283 =head2 Pidfile Handling Methods
 284
 285 =over 4
 286
 287 =item B<init_pidfile>
 288
 289 This method will create a L<MooseX::Daemonize::Pid::File> object and tell
 290 it to store the PID in the file C<$pidbase/$progname.pid>.
 291
 292 =item B<check>
 293
 294 This checks to see if the daemon process is currently running by checking
 295 the pidfile.
 296
 297 =item B<get_pid>
 298
 299 Returns the PID of the daemon process.
 300
 301 =item B<save_pid>
 302
 303 Write the pidfile.
 304
 305 =item B<remove_pid>
 306
 307 Removes the pidfile.
 308
 309 =back
 310
 311 =head2 Signal Handling Methods
 312
 313 =over 4
 314
 315 =item B<setup_signals>
 316
 317 Setup the signal handlers, by default it only sets up handlers for SIGINT and
 318 SIGHUP. If you wish to add more signals just use the C<after> method modifier
 319 and add them.
 320
 321 =item B<handle_sigint>
 322
 323 Handle a INT signal, by default calls C<$self->stop()>
 324
 325 =item B<handle_sighup>
 326
 327 Handle a HUP signal. By default calls C<$self->restart()>
 328
 329 =back
 330
 331 =head2 Introspection
 332
 333 =over 4
 334
 335 =item meta()
 336
 337 The C<meta()> method from L<Class::MOP::Class>
 338
 339 =back
 340
 341 =head1 DEPENDENCIES
 342
 343 L<Moose>, L<MooseX::Getopt>, L<MooseX::Types::Path::Class> and L<POSIX>
 344
 345 =head1 INCOMPATIBILITIES
 346
 347 None reported. Although obviously this will not work on Windows.
 348
 349 =head1 BUGS AND LIMITATIONS
 350
 351 No bugs have been reported.
 352
 353 Please report any bugs or feature requests to
 354 C<bug-acme-dahut-call@rt.cpan.org>, or through the web interface at
 355 L<http://rt.cpan.org>.
 356
 357 =head1 SEE ALSO
 358
 359 L<Proc::Daemon>, L<Daemon::Generic>
 360
 361 =head1 AUTHOR
 362
 363 Chris Prather  C<< <perigrin@cpan.org> >>
 364
 365 =head1 THANKS
 366
 367 Mike Boyko, Matt S. Trout, Stevan Little, Brandon Black, Ash Berlin and the
 368 #moose denzians
 369
 370 Some bug fixes sponsored by Takkle Inc.
 371
 372 =head1 LICENCE AND COPYRIGHT
 373
 374 Copyright (c) 2007, Chris Prather C<< <perigrin@cpan.org> >>. All rights
 375 reserved.
 376
 377 This module is free software; you can redistribute it and/or
 378 modify it under the same terms as Perl itself. See L<perlartistic>.
 379
 380 =head1 DISCLAIMER OF WARRANTY
 381
 382 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
 383 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
 384 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
 385 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
 386 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 387 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
 388 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
 389 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
 390 NECESSARY SERVICING, REPAIR, OR CORRECTION.
 391
 392 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
 393 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
 394 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
 395 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
 396 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
 397 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
 398 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
 399 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
 400 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
 401 SUCH DAMAGES.
 402
 403 =cut