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