lib/MooseX/Daemonize.pm

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