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

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

use MooseX::Daemonize::Types;

our $VERSION = 0.05;

with qw[
    MooseX::Daemonize::Core
    MooseX::Daemonize::WithSignalHandling
    MooseX::Daemonize::WithPidFile    
    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      => 'Path::Class::Dir',
    is       => 'ro',
    coerce   => 1,
    required => 1,    
    lazy     => 1,
    default  => sub { Path::Class::Dir->new('var', 'run') },
);

has basedir => (
    isa      => 'Path::Class::Dir',
    is       => 'ro',
    coerce   => 1,
    required => 1,
    lazy     => 1,
    default  => sub { Path::Class::Dir->new('/') },
);

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

has stop_timeout => (
    isa     => 'Int',
    is      => 'rw',
    default => sub { 2 }
);

sub init_pidfile {
    my $self = shift;
    my $file = $self->pidbase . '/' . $self->progname . '.pid';
    confess "Cannot write to $file" unless (-e $file ? -w $file : -w $self->pidbase);
    MooseX::Daemonize::PidFile->new( file => $file );
}

sub start {
    my ($self) = @_;
    
    confess "instance already running" if $self->pidfile->running;
    
    $self->daemonize unless $self->foreground;

    return unless $self->is_daemon;

    $self->pidfile->pid($$);

    # Avoid 'stdin reopened for output' warning with newer perls
    ## no critic
    open( NULL, '/dev/null' );
    <NULL> if (0);
    ## use critic

    # Change to basedir
    chdir $self->basedir;

    $self->pidfile->write;
    $self->setup_signals;
    return $$;
}

# Make _kill *really* private
my $_kill;

sub stop {
    my ( $self, %args ) = @_;
    my $pid = $self->pidfile->pid;
    $self->$_kill($pid) unless $self->foreground();
    $self->pidfile->remove;
    return 1 if $args{no_exit};
    exit;
}

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

sub handle_signal {
    my ($self, $signal) = @_;
    return $self->handle_sigint if $signal eq 'INT';
    return $self->handle_sighup if $signal eq 'HUP';    
}

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

$_kill = sub {
    my ( $self, $pid ) = @_;
    return unless $pid;
    unless ( CORE::kill 0 => $pid ) {

        # warn "$pid already appears dead.";
        return;
    }

    if ( $pid eq $$ ) {

        # warn "$pid is us! Can't commit suicide.";
        return;
    }

    my $timeout = $self->stop_timeout;

    # kill 0 => $pid returns 0 if the process is dead
    # $!{EPERM} could also be true if we cant kill it (permission error)

    # Try SIGINT ... 2s ... SIGTERM ... 2s ... SIGKILL ... 3s ... UNDEAD!
    for ( [ 2, $timeout ], [15, $timeout], [9, $timeout * 1.5] ) {
        my ($signal, $timeout) = @$_;
        $timeout = int $timeout;
        
        CORE::kill($signal, $pid);
        
        last unless CORE::kill 0 => $pid or $!{EPERM};
        
        while ($timeout) {
            sleep(1);
            last unless CORE::kill 0 => $pid or $!{EPERM};
            $timeout--;
        }
    }

    return unless ( CORE::kill 0 => $pid or $!{EPERM} );

    # IF it is still running
    Carp::carp "$pid doesn't seem to want to die.";     # AHH EVIL DEAD!
};

1;
__END__

=head1 NAME

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

=head1 VERSION

This document describes MooseX::Daemonize version 0.04

=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 Path::Class::Dir | Str

The name of our daemon, defaults to $self->meta->name =~ s/::/_/;

=item pidbase Path::Class::Dir | Str

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

=item pidfile MooseX::Daemonize::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.

=item is_daemon Bool

If true, the process is the backgrounded process. This is useful for example
in an after 'start' => sub { } block

=item stop_timeout

Number of seconds to wait for the process to stop, before trying harder to kill
it. Defaults to 2 seconds

=back

=head1 METHODS 

=over

=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 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. By default calls C<$self->restart()>

=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>, and L<Proc::Daemon>

=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 THANKS

Mike Boyko, Matt S. Trout, Stevan Little, Brandon Black, Ash Berlin and the 
#moose denzians

Some bug fixes sponsored by Takkle Inc.

=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;
a4952679	4
d9e417f4	5	use MooseX::Daemonize::Types;
a392fa53	6
d9e417f4	7	our $VERSION = 0.05;
a4952679	8
18cc5c89	9	with qw[
18cc5c89	10	MooseX::Daemonize::Core
ba19d02e	11	MooseX::Daemonize::WithSignalHandling
d9e417f4	12	MooseX::Daemonize::WithPidFile
18cc5c89	13	MooseX::Getopt
18cc5c89	14	];
a4952679	15
a4952679	16	has progname => (
a392fa53	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	},
a4952679	25	);
a4952679	26
d9e417f4	27	has pidbase => (
2eced271	28	isa => 'Path::Class::Dir',
cbff8e52	29	is => 'ro',
2eced271	30	coerce => 1,
d9e417f4	31	required => 1,
cbff8e52	32	lazy => 1,
d9e417f4	33	default => sub { Path::Class::Dir->new('var', 'run') },
24a6a660	34	);
24a6a660	35
d9e417f4	36	has basedir => (
2eced271	37	isa => 'Path::Class::Dir',
cbff8e52	38	is => 'ro',
2eced271	39	coerce => 1,
d9e417f4	40	required => 1,
cbff8e52	41	lazy => 1,
d9e417f4	42	default => sub { Path::Class::Dir->new('/') },
a4952679	43	);
	44
	45	has foreground => (
2eced271	46	metaclass => 'Getopt',
cbff8e52	47	cmd_aliases => 'f',
a4952679	48	isa => 'Bool',
	49	is => 'ro',
	50	default => sub { 0 },
	51	);
	52
b916501e	53	has stop_timeout => (
	54	isa => 'Int',
	55	is => 'rw',
2eced271	56	default => sub { 2 }
b916501e	57	);
b916501e	58
d9e417f4	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
a4952679	66	sub start {
a4952679	67	my ($self) = @_;
2eced271	68
ff5cee29	69	confess "instance already running" if $self->pidfile->running;
2eced271	70
a4952679	71	$self->daemonize unless $self->foreground;
a4952679	72
cbff8e52	73	return unless $self->is_daemon;
	74
	75	$self->pidfile->pid($$);
	76
3543c999	77	# Avoid 'stdin reopened for output' warning with newer perls
0585edbb	78	## no critic
3543c999	79	open( NULL, '/dev/null' );
3543c999	80	<NULL> if (0);
0585edbb	81	## use critic
fa2b72a4	82
24a6a660	83	# Change to basedir
24a6a660	84	chdir $self->basedir;
fa2b72a4	85
ff5cee29	86	$self->pidfile->write;
3543c999	87	$self->setup_signals;
	88	return $$;
	89	}
	90
b916501e	91	# Make _kill really private
	92	my $_kill;
	93
3543c999	94	sub stop {
3543c999	95	my ( $self, %args ) = @_;
ff5cee29	96	my $pid = $self->pidfile->pid;
b916501e	97	$self->$_kill($pid) unless $self->foreground();
ff5cee29	98	$self->pidfile->remove;
3543c999	99	return 1 if $args{no_exit};
	100	exit;
	101	}
	102
a4952679	103	sub restart {
a4952679	104	my ($self) = @_;
7ada91b8	105	$self->stop( no_exit => 1 );
a4952679	106	$self->start();
	107	}
	108
18cc5c89	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';
a4952679	113	}
a4952679	114
2361a590	115	sub handle_sigint { $_[0]->stop; }
2361a590	116	sub handle_sighup { $_[0]->restart; }
a4952679	117
b916501e	118	$_kill = sub {
a4952679	119	my ( $self, $pid ) = @_;
2361a590	120	return unless $pid;
3543c999	121	unless ( CORE::kill 0 => $pid ) {
	122
	123	# warn "$pid already appears dead.";
	124	return;
	125	}
	126
	127	if ( $pid eq $$ ) {
	128
b916501e	129	# warn "$pid is us! Can't commit suicide.";
a4952679	130	return;
	131	}
	132
b916501e	133	my $timeout = $self->stop_timeout;
a4952679	134
b916501e	135	# kill 0 => $pid returns 0 if the process is dead
b916501e	136	# $!{EPERM} could also be true if we cant kill it (permission error)
a4952679	137
b916501e	138	# Try SIGINT ... 2s ... SIGTERM ... 2s ... SIGKILL ... 3s ... UNDEAD!
b916501e	139	for ( [ 2, $timeout ], [15, $timeout], [9, $timeout * 1.5] ) {
ea9485d8	140	my ($signal, $timeout) = @$_;
	141	$timeout = int $timeout;
	142
	143	CORE::kill($signal, $pid);
	144
b916501e	145	last unless CORE::kill 0 => $pid or $!{EPERM};
ea9485d8	146
	147	while ($timeout) {
	148	sleep(1);
	149	last unless CORE::kill 0 => $pid or $!{EPERM};
	150	$timeout--;
	151	}
a4952679	152	}
a4952679	153
b916501e	154	return unless ( CORE::kill 0 => $pid or $!{EPERM} );
	155
	156	# IF it is still running
d9e417f4	157	Carp::carp "$pid doesn't seem to want to die."; # AHH EVIL DEAD!
b916501e	158	};
a4952679	159
	160	1;
	161	__END__
	162
a4952679	163	=head1 NAME
a4952679	164
b916501e	165	MooseX::Daemonize - provides a Role that daemonizes your Moose based
b916501e	166	application.
a4952679	167
	168	=head1 VERSION
	169
b916501e	170	This document describes MooseX::Daemonize version 0.04
a4952679	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
b916501e	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.
a4952679	198
	199	=head1 ATTRIBUTES
	200
	201	=over
	202
2eced271	203	=item progname Path::Class::Dir \| Str
a4952679	204
cbff8e52	205	The name of our daemon, defaults to $self->meta->name =~ s/::/_/;
a4952679	206
2eced271	207	=item pidbase Path::Class::Dir \| Str
a4952679	208
	209	The base for our bid, defaults to /var/run/$progname
	210
2eced271	211	=item pidfile MooseX::Daemonize::PidFile \| Str
a4952679	212
2eced271	213	The file we store our PID in, defaults to /var/run/$progname
a4952679	214
	215	=item foreground Bool
	216
b916501e	217	If true, the process won't background. Useful for debugging. This option can
b916501e	218	be set via Getopt's -f.
a4952679	219
e7a196e7	220	=item is_daemon Bool
e7a196e7	221
b916501e	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
e7a196e7	229
a4952679	230	=back
	231
	232	=head1 METHODS
	233
	234	=over
	235
a4952679	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
a4952679	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
cecbee2d	261	Handle a INT signal, by default calls C<$self->stop()>
a4952679	262
	263	=item handle_sighup()
	264
cecbee2d	265	Handle a HUP signal. By default calls C<$self->restart()>
a4952679	266
	267	=item meta()
	268
cecbee2d	269	The C<meta()> method from L<Class::MOP::Class>
a4952679	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
2eced271	281	Obviously L<Moose>, and L<Proc::Daemon>
a4952679	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
7ada91b8	320	=head1 THANKS
7ada91b8	321
b916501e	322	Mike Boyko, Matt S. Trout, Stevan Little, Brandon Black, Ash Berlin and the
b916501e	323	#moose denzians
a4952679	324
637573c4	325	Some bug fixes sponsored by Takkle Inc.
637573c4	326
a4952679	327	=head1 LICENCE AND COPYRIGHT
a4952679	328
b916501e	329	Copyright (c) 2007, Chris Prather C<< <perigrin@cpan.org> >>. All rights
b916501e	330	reserved.
a4952679	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.