[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::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($$);
    
    # 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 setup_signals {
    my $self = shift;
    $SIG{'INT'} = sub { $self->handle_sigint };
    $SIG{'HUP'} = sub { $self->handle_sighup };    
}

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