X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FTest%2FMooseX%2FDaemonize.pm;h=dbccc4479176c6c82df022040939635d3f9f4c9b;hb=d5a304d98a6c9092181f55e00551591aeba03406;hp=6b79933d80719753727bacefa5734bd88603dad6;hpb=fa2b72a40f356bef1bcd64dee82cd81e56960c81;p=gitmo%2FMooseX-Daemonize.git diff --git a/lib/Test/MooseX/Daemonize.pm b/lib/Test/MooseX/Daemonize.pm index 6b79933..dbccc44 100644 --- a/lib/Test/MooseX/Daemonize.pm +++ b/lib/Test/MooseX/Daemonize.pm @@ -1,39 +1,30 @@ use strict; - +use warnings; package Test::MooseX::Daemonize; -use Proc::Daemon; -use File::Slurp; # BEGIN CARGO CULTING -use Sub::Exporter; +use Sub::Exporter::ForMethods 'method_installer'; +use Sub::Exporter -setup => { + exports => [ qw(daemonize_ok check_test_output) ], + groups => { default => [ qw(daemonize_ok check_test_output) ] }, + installer => method_installer, +}; + use Test::Builder; -our $VERSION = '0.01'; -our $AUTHORITY = 'cpan:PERIGRIN'; - -my @exports = qw[ - daemonize_ok - check_test_output -]; - -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 ) { + unless ( my $pid = fork ) { $daemon->start(); exit; } else { sleep(1); # Punt on sleep time, 1 seconds should be enough - $Test->ok( -e $daemon->pidfile, $msg ) - || $Test->diag( 'Pidfile (' . $daemon->pidfile->file . ') not found.' ); + $Test->ok( $daemon->pidfile->does_file_exist, $msg ) + || $Test->diag( + 'Pidfile (' . $daemon->pidfile->file . ') not found.' ); } } @@ -50,20 +41,22 @@ sub check_test_output { # We don't just call ok(!$not), because that generates diagnostics of # its own for failures. We only want the diagnostics from the child. - my $num = $Test->current_test; - $Test->current_test( ++$num ); - $Test->_print("$status $num - $text\n"); + my $orig_no_diag = $Test->no_diag; + $Test->no_diag(1); + $Test->ok(!$not, $text); + $Test->no_diag($orig_no_diag); } elsif ( $line =~ s/\A#\s?// ) { $Test->diag($line); } else { - $Test->_print_diag("$label: $line (unrecognised)\n"); + $Test->diag("$label: $line (unrecognised)\n"); } } } package Test::MooseX::Daemonize::Testable; + use Moose::Role; has test_output => ( @@ -91,146 +84,58 @@ after daemonize => sub { 1; __END__ +=pod =head1 NAME -Test::MooseX::Daemonize - provides a Role that daemonizes your Moose based application. - +Test::MooseX::Daemonize - Tool to help test MooseX::Daemonize applications -=head1 VERSION - -This document describes MooseX::Daemonize version 0.0.1 +=head1 SYNOPSIS + use File::Spec::Functions; + use File::Temp qw(tempdir); -=head1 SYNOPSIS - - package main; - use Cwd; + my $dir = tempdir( CLEANUP => 1 ); ## 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 ); + my $file = catfile( $dir, "im_alive" ); + my $daemon = FileMaker->new( pidbase => $dir, 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() +This module provides some basic Test::Builder compatible test methods to +use when writing tests for you MooseX::Daemonize based modules. -Check to see if an instance is already running. +=head1 EXPORTED FUNCTIONS -=item start() +=over 4 -Setup a pidfile, fork, then setup the signal handlers. +=item B -=item stop() +This will attempt to daemonize your C<$daemon> returning ok on +success and not ok on failure. -Stop the process matching the pidfile, and unlinks the pidfile. +=item B -=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 - -=item daemonize_ok() - -=item check_test_output() +This is expected to be used with a C<$daemon> which does the +B role (included in this package +see the source for more info). It will collect the test output +from your daemon and apply it in the parent process by mucking +around with L stuff, again, read the source for +more info. If we get time we will document this more thoroughly. =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 @@ -239,21 +144,19 @@ L. =head1 SEE ALSO -L, L, L +L =head1 AUTHOR Chris Prather C<< >> - =head1 LICENCE AND COPYRIGHT -Copyright (c) 2007, Chris Prather C<< >>. All rights reserved. +Copyright (c) 2007-2011, 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 @@ -276,3 +179,5 @@ 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