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 use Moose::Util::TypeConstraints;
   6
   7 our $VERSION = 0.05;
   8
   9 use Carp 'carp';
  10 use Proc::Daemon;
  11 use MooseX::Daemonize::PidFile;
  12
  13 with qw(MooseX::Getopt);
  14
  15 has progname => (
  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 basedir => (
  27     isa      => 'Path::Class::Dir',
  28     is       => 'ro',
  29     coerce   => 1,
  30     required => 1,
  31     lazy     => 1,
  32     default  => sub { Path::Class::Dir->new('/') },
  33 );
  34
  35 has pidbase => (
  36     isa      => 'Path::Class::Dir',
  37     is       => 'ro',
  38     coerce   => 1,
  39     required => 1,
  40     lazy     => 1,
  41     default  => sub { Path::Class::Dir->new('var', 'run') },
  42 );
  43
  44 coerce 'MooseX::Daemonize::PidFile'
  45     => from 'Str'
  46         => via { MooseX::Daemonize::PidFile->new( file => $_ ) };
  47
  48 has pidfile => (
  49     isa       => 'MooseX::Daemonize::PidFile',
  50     is        => 'rw',
  51     lazy      => 1,
  52     required  => 1,
  53     coerce    => 1,
  54     predicate => 'has_pidfile',
  55     default   => sub {
  56         my $file = $_[0]->pidbase . '/' . $_[0]->progname . '.pid';
  57         confess "Cannot write to $file" unless (-e $file ? -w $file : -w $_[0]->pidbase);
  58         MooseX::Daemonize::PidFile->new( file => $file );
  59     },
  60     handles => {
  61         check      => 'running',
  62         save_pid   => 'write',
  63         remove_pid => 'remove',
  64         get_pid    => 'pid',
  65     },
  66 );
  67
  68 has foreground => (
  69     metaclass   => 'Getopt',
  70     cmd_aliases => 'f',
  71     isa         => 'Bool',
  72     is          => 'ro',
  73     default     => sub { 0 },
  74 );
  75
  76 has is_daemon => (
  77     isa     => 'Bool',
  78     is      => 'rw',
  79     default => sub { 0 },
  80 );
  81
  82 has stop_timeout => (
  83     isa     => 'Int',
  84     is      => 'rw',
  85     default => sub { 2 }
  86 );
  87
  88 sub daemonize {
  89     my ($self) = @_;
  90     return if Proc::Daemon::Fork;
  91     Proc::Daemon::Init;
  92     $self->is_daemon(1);
  93 }
  94
  95 sub start {
  96     my ($self) = @_;
  97
  98     confess "instance already running" if $self->check;
  99
 100     $self->daemonize unless $self->foreground;
 101
 102     return unless $self->is_daemon;
 103
 104     $self->pidfile->pid($$);
 105
 106     # Avoid 'stdin reopened for output' warning with newer perls
 107     ## no critic
 108     open( NULL, '/dev/null' );
 109     <NULL> if (0);
 110     ## use critic
 111
 112     # Change to basedir
 113     chdir $self->basedir;
 114
 115     $self->save_pid;
 116     $self->setup_signals;
 117     return $$;
 118 }
 119
 120 # Make _kill *really* private
 121 my $_kill;
 122
 123 sub stop {
 124     my ( $self, %args ) = @_;
 125     my $pid = $self->get_pid;
 126     $self->$_kill($pid) unless $self->foreground();
 127     $self->remove_pid;
 128     return 1 if $args{no_exit};
 129     exit;
 130 }
 131
 132 sub restart {
 133     my ($self) = @_;
 134     $self->stop( no_exit => 1 );
 135     $self->start();
 136 }
 137
 138 sub setup_signals {
 139     my ($self) = @_;
 140     $SIG{INT} = sub { $self->handle_sigint; };
 141     $SIG{HUP} = sub { $self->handle_sighup };
 142 }
 143
 144 sub handle_sigint { $_[0]->stop; }
 145 sub handle_sighup { $_[0]->restart; }
 146
 147 $_kill = sub {
 148     my ( $self, $pid ) = @_;
 149     return unless $pid;
 150     unless ( CORE::kill 0 => $pid ) {
 151
 152         # warn "$pid already appears dead.";
 153         return;
 154     }
 155
 156     if ( $pid eq $$ ) {
 157
 158         # warn "$pid is us! Can't commit suicide.";
 159         return;
 160     }
 161
 162     my $timeout = $self->stop_timeout;
 163
 164     # kill 0 => $pid returns 0 if the process is dead
 165     # $!{EPERM} could also be true if we cant kill it (permission error)
 166
 167     # Try SIGINT ... 2s ... SIGTERM ... 2s ... SIGKILL ... 3s ... UNDEAD!
 168     for ( [ 2, $timeout ], [15, $timeout], [9, $timeout * 1.5] ) {
 169       my ($signal, $timeout) = @$_;
 170       $timeout = int $timeout;
 171
 172       CORE::kill($signal, $pid);
 173
 174       last unless CORE::kill 0 => $pid or $!{EPERM};
 175
 176       while ($timeout) {
 177         sleep(1);
 178         last unless CORE::kill 0 => $pid or $!{EPERM};
 179         $timeout--;
 180       }
 181     }
 182
 183     return unless ( CORE::kill 0 => $pid or $!{EPERM} );
 184
 185     # IF it is still running
 186     carp "$pid doesn't seem to want to die.";     # AHH EVIL DEAD!
 187 };
 188
 189 1;
 190 __END__
 191
 192 =head1 NAME
 193
 194 MooseX::Daemonize - provides a Role that daemonizes your Moose based
 195 application.
 196
 197 =head1 VERSION
 198
 199 This document describes MooseX::Daemonize version 0.04
 200
 201 =head1 SYNOPSIS
 202
 203     package FileMaker;
 204     use Moose;
 205     with qw(MooseX::Daemonize);
 206
 207     sub create_file {
 208         my ( $self, $file ) = @_;
 209         open( FILE, ">$file" ) || die;
 210         close(FILE);
 211     }
 212
 213     no Moose;
 214
 215     # then in the main package ...
 216
 217     my $daemon = FileMaker->new();
 218     $daemon->start();
 219     $daemon->create_file($file);
 220     $daemon->stop();
 221
 222 =head1 DESCRIPTION
 223
 224 Often you want to write a persistant daemon that has a pid file, and responds
 225 appropriately to Signals.  This module helps provide the basic infrastructure
 226 to do that.
 227
 228 =head1 ATTRIBUTES
 229
 230 =over
 231
 232 =item progname Path::Class::Dir | Str
 233
 234 The name of our daemon, defaults to $self->meta->name =~ s/::/_/;
 235
 236 =item pidbase Path::Class::Dir | Str
 237
 238 The base for our bid, defaults to /var/run/$progname
 239
 240 =item pidfile MooseX::Daemonize::PidFile | Str
 241
 242 The file we store our PID in, defaults to /var/run/$progname
 243
 244 =item foreground Bool
 245
 246 If true, the process won't background. Useful for debugging. This option can
 247 be set via Getopt's -f.
 248
 249 =item is_daemon Bool
 250
 251 If true, the process is the backgrounded process. This is useful for example
 252 in an after 'start' => sub { } block
 253
 254 =item stop_timeout
 255
 256 Number of seconds to wait for the process to stop, before trying harder to kill
 257 it. Defaults to 2 seconds
 258
 259 =back
 260
 261 =head1 METHODS
 262
 263 =over
 264
 265 =item check()
 266
 267 Check to see if an instance is already running.
 268
 269 =item start()
 270
 271 Setup a pidfile, fork, then setup the signal handlers.
 272
 273 =item stop()
 274
 275 Stop the process matching the pidfile, and unlinks the pidfile.
 276
 277 =item restart()
 278
 279 Litterally
 280
 281     $self->stop();
 282     $self->start();
 283
 284 =item daemonize()
 285
 286 Calls C<Proc::Daemon::Init> to daemonize this process.
 287
 288 =item setup_signals()
 289
 290 Setup the signal handlers, by default it only sets up handlers for SIGINT and SIGHUP
 291
 292 =item handle_sigint()
 293
 294 Handle a INT signal, by default calls C<$self->stop()>
 295
 296 =item handle_sighup()
 297
 298 Handle a HUP signal. By default calls C<$self->restart()>
 299
 300 =item get_pid
 301
 302 Lookup the pid from our pidfile.
 303
 304 =item save_pid
 305
 306 Save the current pid in our pidfile
 307
 308 =item remove_pid
 309
 310 Delete our pidfile
 311
 312 =item meta()
 313
 314 The C<meta()> method from L<Class::MOP::Class>
 315
 316 =back
 317
 318 =head1 DEPENDENCIES
 319
 320 =for author to fill in:
 321     A list of all the other modules that this module relies upon,
 322     including any restrictions on versions, and an indication whether
 323     the module is part of the standard Perl distribution, part of the
 324     module's distribution, or must be installed separately. ]
 325
 326 Obviously L<Moose>, and L<Proc::Daemon>
 327
 328 =head1 INCOMPATIBILITIES
 329
 330 =for author to fill in:
 331     A list of any modules that this module cannot be used in conjunction
 332     with. This may be due to name conflicts in the interface, or
 333     competition for system or program resources, or due to internal
 334     limitations of Perl (for example, many modules that use source code
 335     filters are mutually incompatible).
 336
 337 None reported.
 338
 339
 340 =head1 BUGS AND LIMITATIONS
 341
 342 =for author to fill in:
 343     A list of known problems with the module, together with some
 344     indication Whether they are likely to be fixed in an upcoming
 345     release. Also a list of restrictions on the features the module
 346     does provide: data types that cannot be handled, performance issues
 347     and the circumstances in which they may arise, practical
 348     limitations on the size of data sets, special cases that are not
 349     (yet) handled, etc.
 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>, L<MooseX::Getopt>
 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
 381 =head1 DISCLAIMER OF WARRANTY
 382
 383 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
 384 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
 385 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
 386 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
 387 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 388 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
 389 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
 390 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
 391 NECESSARY SERVICING, REPAIR, OR CORRECTION.
 392
 393 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
 394 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
 395 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
 396 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
 397 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
 398 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
 399 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
 400 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
 401 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
 402 SUCH DAMAGES.