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

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

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;

    # make sure to clear the PID 
    # so that a bad value doesn't
    # stick around in the parent
    $self->pidfile->clear_pid;
    
    return unless $self->is_daemon;

    $self->pidfile->pid($$);
    
    # Avoid 'stdin reopened for output'
    # warning with newer perls
    open( NULL, '/dev/null' );
    <NULL> if (0);    

    # 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__

=pod

=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 daemonize from MooseX::Daemonize::Core.

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

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