lib/Test/MooseX/Daemonize.pm

   1 package Test::MooseX::Daemonize;
   2 use strict;
   3
   4 our $VERSION   = '0.15';
   5 our $AUTHORITY = 'cpan:PERIGRIN';
   6
   7 # BEGIN CARGO CULTING
   8 use Sub::Exporter;
   9 use Test::Builder;
  10
  11
  12 {
  13     my @exports = qw[
  14       daemonize_ok
  15       check_test_output
  16     ];
  17
  18     Sub::Exporter::setup_exporter(
  19         {
  20             exports => \@exports,
  21             groups  => { default => \@exports }
  22         }
  23     );
  24 }
  25
  26 our $Test = Test::Builder->new;
  27
  28 sub daemonize_ok {
  29     my ( $daemon, $msg ) = @_;
  30     unless ( my $pid = fork ) {
  31         $daemon->start();
  32         exit;
  33     }
  34     else {
  35         sleep(1);    # Punt on sleep time, 1 seconds should be enough
  36         $Test->ok( $daemon->pidfile->does_file_exist, $msg )
  37           || $Test->diag(
  38             'Pidfile (' . $daemon->pidfile->file . ') not found.' );
  39     }
  40 }
  41
  42 sub check_test_output {
  43     my ($app) = @_;
  44     open( my $stdout_in, '<', $app->test_output )
  45       or die "can't open test output: $!";
  46     while ( my $line = <$stdout_in> ) {
  47         $line =~ s/\s+\z//;
  48         my $label;
  49         if ( $line =~ /\A((not\s+)?ok)(?:\s+-)(?:\s+(.*))\z/ ) {
  50             my ( $status, $not, $text ) = ( $1, $2, $3 );
  51             $text ||= '';
  52
  53            # We don't just call ok(!$not), because that generates diagnostics of
  54            # its own for failures. We only want the diagnostics from the child.
  55             my $num = $Test->current_test;
  56             $Test->current_test( ++$num );
  57             $Test->_print("$status $num - $text\n");
  58         }
  59         elsif ( $line =~ s/\A#\s?// ) {
  60             $Test->diag($line);
  61         }
  62         else {
  63             $Test->_print_diag("$label: $line (unrecognised)\n");
  64         }
  65     }
  66 }
  67
  68 package Test::MooseX::Daemonize::Testable;
  69 use Moose::Role;
  70
  71 has test_output => (
  72     isa      => 'Str',
  73     is       => 'ro',
  74     required => 1,
  75 );
  76
  77 after daemonize => sub {
  78     $Test->use_numbers(0);
  79     $Test->no_ending(1);
  80     open my $out, '>', $_[0]->test_output or die "Cannot open test output: $!";
  81     my $fileno = fileno $out;
  82     open STDERR, ">&=", $fileno
  83       or die "Can't redirect STDERR";
  84
  85     open STDOUT, ">&=", $fileno
  86       or die "Can't redirect STDOUT";
  87
  88     $Test->output($out);
  89     $Test->failure_output($out);
  90     $Test->todo_output($out);
  91 };
  92
  93 1;
  94 __END__
  95
  96 =pod
  97
  98 =head1 NAME
  99
 100 Test::MooseX::Daemonize - Tool to help test MooseX::Daemonize applications
 101
 102 =head1 VERSION
 103
 104 This document describes MooseX::Daemonize version 0.0.1
 105
 106 =head1 SYNOPSIS
 107
 108     use File::Spec::Functions;
 109     use File::Temp qw(tempdir);
 110
 111     my $dir = tempdir( CLEANUP => 1 );
 112
 113     ## Try to make sure we are in the test directory
 114
 115     my $file = catfile( $dir, "im_alive" );
 116     my $daemon = FileMaker->new( pidbase => $dir, filename => $file );
 117
 118     daemonize_ok( $daemon, 'child forked okay' );
 119     ok( -e $file, "$file exists" );
 120
 121 =head1 DESCRIPTION
 122
 123 This module provides some basic Test::Builder compatible test methods to
 124 use when writing tests for you MooseX::Daemonize based modules.
 125
 126 =head1 EXPORTED FUNCTIONS
 127
 128 =over 4
 129
 130 =item B<daemonize_ok ( $daemon, ?$msg )>
 131
 132 This will attempt to daemonize your C<$daemon> returning ok on
 133 success and not ok on failure.
 134
 135 =item B<check_test_output ( $daemon )>
 136
 137 This is expected to be used with a C<$daemon> which does the
 138 B<Test::MooseX::Daemonize::Testable> role (included in this package
 139 see the source for more info). It will collect the test output
 140 from your daemon and apply it in the parent process by mucking
 141 around with L<Test::Builder> stuff, again, read the source for
 142 more info. If we get time we will document this more thoroughly.
 143
 144 =back
 145
 146 =head1 INCOMPATIBILITIES
 147
 148 None reported.
 149
 150 =head1 BUGS AND LIMITATIONS
 151
 152 No bugs have been reported.
 153
 154 Please report any bugs or feature requests to
 155 C<bug-acme-dahut-call@rt.cpan.org>, or through the web interface at
 156 L<http://rt.cpan.org>.
 157
 158 =head1 SEE ALSO
 159
 160 L<MooseX::Daemonize>
 161
 162 =head1 AUTHOR
 163
 164 Chris Prather  C<< <perigrin@cpan.org> >>
 165
 166 =head1 LICENCE AND COPYRIGHT
 167
 168 Copyright (c) 2007-2011, Chris Prather C<< <perigrin@cpan.org> >>. All rights reserved.
 169
 170 This module is free software; you can redistribute it and/or
 171 modify it under the same terms as Perl itself. See L<perlartistic>.
 172
 173 =head1 DISCLAIMER OF WARRANTY
 174
 175 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
 176 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
 177 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
 178 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
 179 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 180 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
 181 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
 182 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
 183 NECESSARY SERVICING, REPAIR, OR CORRECTION.
 184
 185 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
 186 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
 187 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
 188 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
 189 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
 190 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
 191 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
 192 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
 193 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
 194 SUCH DAMAGES.
 195
 196 =cut