[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::Pid::File->new( file => $file );
}

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

    return unless $self->is_daemon;

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

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