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