lib/MooseX/Daemonize.pm

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