lib/Test/MooseX/Daemonize.pm

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