package Test::MooseX::Daemonize;
use strict;
-use Test::More;
-use Proc::Daemon;
+
+our $VERSION = '0.15';
+our $AUTHORITY = 'cpan:PERIGRIN';
# 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 }
-});
+{
+ 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(5); # Punt on sleep time, 5 seconds should be enough
- $Test->ok( kill 0 => $pid or $!{EPERM}, $msg );
- return $pid;
+ sleep(1); # Punt on sleep time, 1 seconds should be enough
+ $Test->ok( $daemon->pidfile->does_file_exist, $msg )
+ || $Test->diag(
+ 'Pidfile (' . $daemon->pidfile->file . ') not found.' );
+ }
+}
+
+sub check_test_output {
+ my ($app) = @_;
+ open( my $stdout_in, '<', $app->test_output )
+ or die "can't open test output: $!";
+ while ( my $line = <$stdout_in> ) {
+ $line =~ s/\s+\z//;
+ my $label;
+ if ( $line =~ /\A((not\s+)?ok)(?:\s+-)(?:\s+(.*))\z/ ) {
+ my ( $status, $not, $text ) = ( $1, $2, $3 );
+ $text ||= '';
+
+ # 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");
+ }
+ elsif ( $line =~ s/\A#\s?// ) {
+ $Test->diag($line);
+ }
+ else {
+ $Test->_print_diag("$label: $line (unrecognised)\n");
+ }
}
}
+package Test::MooseX::Daemonize::Testable;
+use Moose::Role;
+
+has test_output => (
+ isa => 'Str',
+ is => 'ro',
+ required => 1,
+);
+
+after daemonize => sub {
+ $Test->use_numbers(0);
+ $Test->no_ending(1);
+ open my $out, '>', $_[0]->test_output or die "Cannot open test output: $!";
+ my $fileno = fileno $out;
+ open STDERR, ">&=", $fileno
+ or die "Can't redirect STDERR";
+
+ open STDOUT, ">&=", $fileno
+ or die "Can't redirect STDOUT";
+
+ $Test->output($out);
+ $Test->failure_output($out);
+ $Test->todo_output($out);
+};
+
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
-
- package main;
- use Cwd;
+
+ use File::Spec::Functions;
+ use File::Temp qw(tempdir);
+
+ 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
+This module provides some basic Test::Builder compatible test methods to
+use when writing tests for you MooseX::Daemonize based modules.
-=item pidbase Str
+=head1 EXPORTED FUNCTIONS
-The base for our bid, defaults to /var/run/$progname
+=over 4
-=item pidfile Str
+=item B<daemonize_ok ( $daemon, ?$msg )>
-The file we store our PID in, defaults to /var/run/$progname/
+This will attempt to daemonize your C<$daemon> returning ok on
+success and not ok on failure.
-=item foreground Bool
+=item B<check_test_output ( $daemon )>
-If true, the process won't background. Useful for debugging. This option can be set via Getopt's -f.
+This is expected to be used with a C<$daemon> which does the
+B<Test::MooseX::Daemonize::Testable> 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<Test::Builder> stuff, again, read the source for
+more info. If we get time we will document this more thoroughly.
=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 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
=head1 SEE ALSO
-L<Proc::Daemon>, L<Daemon::Generic>, L<MooseX::Getopt>
+L<MooseX::Daemonize>
=head1 AUTHOR
Chris Prather C<< <perigrin@cpan.org> >>
-
=head1 LICENCE AND COPYRIGHT
-Copyright (c) 2007, Chris Prather C<< <perigrin@cpan.org> >>. All rights reserved.
+Copyright (c) 2007-2011, 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
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
+SUCH DAMAGES.
+
+=cut