[gitmo/MooseX-Daemonize.git] / lib / MooseX / Daemonize.pm

package MooseX::Daemonize;
use strict;    # because Kwalitee is pedantic
use Moose::Role;

our $VERSION = 0.01;
use Carp;
use Proc::Daemon;

use File::Flock;
use File::Slurp;

with qw(MooseX::Getopt);

has progname => (
    isa      => 'Str',
    is       => 'ro',
    lazy     => 1,
    required => 1,
    default  => sub {
        ( my $name = lc $_[0]->meta->name ) =~ s/::/_/g;
        return $name;
    },
);

has pidbase => (
    isa      => 'Str',
    is       => 'ro',
    lazy     => 1,
    required => 1,
    default  => sub { return '/var/run' },
);

has pidfile => (
    isa      => 'Str',
    is       => 'ro',
    lazy     => 1,
    required => 1,
    default  => sub { $_[0]->pidbase . '/' . $_[0]->progname . '.pid' },
);

has foreground => (
    metaclass   => 'Getopt',
    cmd_aliases => ['f'],
    isa         => 'Bool',
    is          => 'ro',
    default     => sub { 0 },
);

sub check {
    my ($self) = @_;
    my $pidfile = $self->pidfile;
    if ( -e $pidfile ) {
        my $prog = $self->progname;
        chomp( my $pid = read_file($pidfile) );
        if ( kill 0 => $pid ) {
            croak "$prog already running ($pid).";
        }
        carp "$prog not running but $pidfile exists. Perhaps it is stale?";
        return 1;
    }
    return 0;
}

sub daemonize {
    my ($self) = @_;
    Proc::Daemon::Init;
}

sub start {
    my ($self) = @_;
    return if $self->check;

    $self->daemonize unless $self->foreground;

    my $pidfile = $self->pidfile;
    lock( $pidfile, undef, 'nonblocking' )
      or croak "Could not lock PID file $pidfile: $!";
    write_file( $pidfile, "$$\n" );
    unlock($pidfile);
    $self->setup_signals;
    return;
}

sub stop {
    my ($self) = @_;
    my $pidfile = $self->pidfile;
    unless ( -e $pidfile ) {
        carp $self->progname . ' is not currently running.';
        return;
    }
    chomp( my $pid = read_file($pidfile) );
    $self->kill($pid) unless $self->foreground();
    lock( $pidfile, undef, 'nonblocking' )
      or croak "Could not lock PID file $pidfile: $!";
    unlink($pidfile);
    unlock($pidfile);
    return;
}

sub restart {
    my ($self) = @_;
    $self->stop();
    $self->start();
}

sub setup_signals {
    my $self = @_;
    $SIG{INT} = sub { $_[0]->handle_sigint; };
    $SIG{HUP} = sub { $_[0]->handle_sighup };
}

sub handle_sigint { $_[0]->stop; }
sub handle_sighup { return; }

sub kill {
    my ( $self, $pid ) = @_;
    unless ( kill 0 => $pid ) {
        carp "$pid already appears dead.";
        return;
    }

    kill( 2, $pid );    # Try SIGINT
    sleep(1) if kill( 0, $pid );

    unless ( kill 0 => $pid or $!{EPERM} ) {    # IF it is still running
        kill( 15, $pid );                       # try SIGTERM
        sleep(1) if kill( 0, $pid );
    }

    unless ( kill 0 => $pid or $!{EPERM} ) {    # IF it is still running
        kill( 9, $pid );                        # finally try SIGKILL
        sleep(1) if kill( 0, $pid );
    }

    unless ( kill 0 => $pid or $!{EPERM} ) {    # IF it is still running
        carp "$pid doesn't seem to want to die.";    # AHH EVIL DEAD!
    }

    return;
}

1;
__END__

=head1 NAME

MooseX::Daemonize - provides a Role that daemonizes your Moose based application.


=head1 VERSION

This document describes MooseX::Daemonize version 0.0.1


=head1 SYNOPSIS

    package FileMaker;
    use Moose;
    with qw(MooseX::Daemonize);

    sub create_file {
        my ( $self, $file ) = @_;
        open( FILE, ">$file" ) || die;
        close(FILE);
    }

    no Moose;

    # then in the main package ... 
    
    my $daemon = FileMaker->new();
    $daemon->start();
    $daemon->create_file($file);
    $daemon->stop();
     
=head1 DESCRIPTION

Often you want to write a persistant daemon that has a pid file, and responds appropriately to Signals. 
This module helps provide the basic infrastructure to do that.

=head1 ATTRIBUTES

=over

=item progname Str

The name of our daemon, defaults to $0

=item pidbase Str

The base for our bid, defaults to /var/run/$progname

=item pidfile Str

The file we store our PID in, defaults to /var/run/$progname/ 

=item foreground Bool

If true, the process won't background. Useful for debugging. This option can be set via Getopt's -f.

=back

=head1 METHODS 

=over

=item check()

Check to see if an instance is already running.

=item start()

Setup a pidfile, fork, then setup the signal handlers.

=item stop()

Stop the process matching the pidfile, and unlinks the pidfile.

=item restart()

Litterally 

    $self->stop();
    $self->start();

=item daemonize()

Calls C<Proc::Daemon::Init> to daemonize this process. 

=item kill($pid)

Kills the process for $pid. This will try SIGINT, and SIGTERM before falling back to SIGKILL and finally giving up.

=item setup_signals()

Setup the signal handlers, by default it only sets up handlers for SIGINT and SIGHUP

=item handle_sigint()

Handle a INT signal, by default calls C<$self->stop()>;

=item handle_sighup()

Handle a HUP signal. Nothing is done by default.

=item meta()

the C<meta()> method from L<Class::MOP::Class>

=back

=head1 DEPENDENCIES

=for author to fill in:
    A list of all the other modules that this module relies upon,
    including any restrictions on versions, and an indication whether
    the module is part of the standard Perl distribution, part of the
    module's distribution, or must be installed separately. ]

Obviously L<Moose>, also L<Carp>, L<Proc::Daemon>, L<File::Flock>, L<File::Slurp>

=head1 INCOMPATIBILITIES

=for author to fill in:
    A list of any modules that this module cannot be used in conjunction
    with. This may be due to name conflicts in the interface, or
    competition for system or program resources, or due to internal
    limitations of Perl (for example, many modules that use source code
    filters are mutually incompatible).

None reported.


=head1 BUGS AND LIMITATIONS

=for author to fill in:
    A list of known problems with the module, together with some
    indication Whether they are likely to be fixed in an upcoming
    release. Also a list of restrictions on the features the module
    does provide: data types that cannot be handled, performance issues
    and the circumstances in which they may arise, practical
    limitations on the size of data sets, special cases that are not
    (yet) handled, etc.

No bugs have been reported.

Please report any bugs or feature requests to
C<bug-acme-dahut-call@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org>.

=head1 SEE ALSO

L<Proc::Daemon>, L<Daemon::Generic>, L<MooseX::Getopt>

=head1 AUTHOR

Chris Prather  C<< <perigrin@cpan.org> >>


=head1 LICENCE AND COPYRIGHT

Copyright (c) 2007, Chris Prather C<< <perigrin@cpan.org> >>. All rights reserved.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.


=head1 DISCLAIMER OF WARRANTY

BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
NECESSARY SERVICING, REPAIR, OR CORRECTION.

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