From: Chris Prather Date: Fri, 18 May 2007 04:04:14 +0000 (+0000) Subject: add Test::MooseX::Daemonize X-Git-Tag: 0.01~8 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7d7115e52be1d2728ff32b540ad4077f2223d515;hp=a49526793f4ad674abfd7670f4c6a0de9b6df265;p=gitmo%2FMooseX-Daemonize.git add Test::MooseX::Daemonize --- diff --git a/lib/MooseX/Daemonize.pm b/lib/MooseX/Daemonize.pm index 2a92e61..62e7034 100644 --- a/lib/MooseX/Daemonize.pm +++ b/lib/MooseX/Daemonize.pm @@ -136,7 +136,6 @@ sub kill { 1; __END__ - =head1 NAME MooseX::Daemonize - provides a Role that daemonizes your Moose based application. diff --git a/lib/Test/MooseX/Daemonize.pm b/lib/Test/MooseX/Daemonize.pm new file mode 100644 index 0000000..6160c65 --- /dev/null +++ b/lib/Test/MooseX/Daemonize.pm @@ -0,0 +1,219 @@ +package Test::MooseX::Daemonize; +use strict; +use Test::More; +use Proc::Daemon; + +# BEGIN CARGO CULTING +use Sub::Exporter; +use Test::Builder; +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:PERIGRIN'; + +my @exports = qw[ + daemonize_ok +]; + +Sub::Exporter::setup_exporter({ + exports => \@exports, + groups => { default => \@exports } +}); + +our $Test = Test::Builder->new; + +sub daemonize_ok { + my ( $daemon, $msg ) = @_; + unless ( my $pid = Proc::Daemon::Fork ) { + $daemon->start(); + exit; + } + else { + sleep(5); # Punt on sleep time, 5 seconds should be enough + $Test->ok( kill 0 => $pid or $!{EPERM}, $msg ); + return $pid; + } +} + +1; +__END__ + + +=head1 NAME + +Test::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 main; + use Cwd; + + ## Try to make sure we are in the test directory + chdir 't' if ( Cwd::cwd() !~ m|/t$| ); + my $cwd = Cwd::cwd(); + + my $file = join( '/', $cwd, 'im_alive' ); + my $daemon = FileMaker->new( pidbase => '.', filename => $file ); + + daemonize_ok( $daemon, 'child forked okay' ); + ok( -e $file, "$file exists" ); + unlink($file); + +=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 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 meta() + +the C method from L + +=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, also L, L, L, L + +=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, or through the web interface at +L. + +=head1 SEE ALSO + +L, L, L + +=head1 AUTHOR + +Chris Prather C<< >> + + +=head1 LICENCE AND COPYRIGHT + +Copyright (c) 2007, Chris Prather C<< >>. 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. + + +=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. \ No newline at end of file diff --git a/t/01.filecreate.t b/t/01.filecreate.t index a0e27d9..e6a161b 100644 --- a/t/01.filecreate.t +++ b/t/01.filecreate.t @@ -1,6 +1,5 @@ -use Test::More no_plan => 1; -use Proc::Daemon; -use Cwd; +use Test::More tests => 2; +use Test::MooseX::Daemonize; ## Since a daemon will not be able to print terminal output, we ## have a test daemon create a file, and another process test for @@ -12,6 +11,10 @@ use Cwd; use Moose; with qw(MooseX::Daemonize); + has filename => ( isa => 'Str', is => 'ro' ); + + after start => sub { $_[0]->create_file( $_[0]->filename ) }; + sub create_file { my ( $self, $file ) = @_; open( FILE, ">$file" ) || die $!; @@ -21,25 +24,18 @@ use Cwd; no Moose; } + package main; +use Cwd; ## Try to make sure we are in the test directory +chdir 't' if ( Cwd::cwd() !~ m|/t$| ); my $cwd = Cwd::cwd(); -chdir 't' if ( $cwd !~ m|/t$| ); -$cwd = Cwd::cwd(); -## Test filename my $file = join( '/', $cwd, 'im_alive' ); -## Parent process will check if file created. Child becomes the daemon. -if ( my $pid = Proc::Daemon::Fork ) { - sleep(5); # Punt on sleep time, 5 seconds should be enough - ok( -e $file, "$file exists"); - unlink($file); -} -else { - my $daemon = FileMaker->new(pidbase => '.'); - $daemon->start(); - $daemon->create_file($file); - $daemon->stop(); - exit; -} +my $daemon = FileMaker->new( pidbase => '.', filename => $file ); + +daemonize_ok( $daemon, 'child forked okay' ); +ok( -e $file, "$file exists" ); +unlink($file); +