lib/MooseX/Daemonize.pm

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