[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 {
        die 'Cannot write to ' . $_[0]->pidbase unless -w $_[0]->pidbase;
        $_[0]->pidbase . '/' . $_[0]->progname . '.pid';
    },
);

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

sub check {
    my ($self) = @_;
    if ( my $pid = $self->get_pid ) {
        my $prog = $self->progname;
        if ( CORE::kill 0 => $pid ) {
            croak "$prog already running ($pid).";
        }
        carp "$prog not running but $pid 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;

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

    $self->save_pid;
    $self->setup_signals;
    return $$;
}

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

sub remove_pid {
    my ($self) = @_;
    my $pidfile = $self->pidfile;
    lock( $pidfile, undef, 'nonblocking' )
      or croak "Could not lock PID file $pidfile: $!";
    unlink($pidfile);
    unlock($pidfile);
    return;
}

sub get_pid {
    my ($self) = @_;
    my $pidfile = $self->pidfile;
    return unless -e $pidfile;
    chomp( my $pid = read_file($pidfile) );
    return $pid;
}

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

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

sub setup_signals {
    my ($self) = @_;
    $SIG{INT} = sub { $self->handle_sigint; };
    $SIG{HUP} = sub { $self->handle_sighup };
}

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

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

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

    if ( $pid eq $$ ) {

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

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

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

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

    unless ( CORE::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 get_pid

=item save_pid

=item remove_pid

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