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 SYNOPSIS
 104
 105     use File::Spec::Functions;
 106     use File::Temp qw(tempdir);
 107
 108     my $dir = tempdir( CLEANUP => 1 );
 109
 110     ## Try to make sure we are in the test directory
 111
 112     my $file = catfile( $dir, "im_alive" );
 113     my $daemon = FileMaker->new( pidbase => $dir, filename => $file );
 114
 115     daemonize_ok( $daemon, 'child forked okay' );
 116     ok( -e $file, "$file exists" );
 117
 118 =head1 DESCRIPTION
 119
 120 This module provides some basic Test::Builder compatible test methods to
 121 use when writing tests for you MooseX::Daemonize based modules.
 122
 123 =head1 EXPORTED FUNCTIONS
 124
 125 =over 4
 126
 127 =item B<daemonize_ok ( $daemon, ?$msg )>
 128
 129 This will attempt to daemonize your C<$daemon> returning ok on
 130 success and not ok on failure.
 131
 132 =item B<check_test_output ( $daemon )>
 133
 134 This is expected to be used with a C<$daemon> which does the
 135 B<Test::MooseX::Daemonize::Testable> role (included in this package
 136 see the source for more info). It will collect the test output
 137 from your daemon and apply it in the parent process by mucking
 138 around with L<Test::Builder> stuff, again, read the source for
 139 more info. If we get time we will document this more thoroughly.
 140
 141 =back
 142
 143 =head1 INCOMPATIBILITIES
 144
 145 None reported.
 146
 147 =head1 BUGS AND LIMITATIONS
 148
 149 No bugs have been reported.
 150
 151 Please report any bugs or feature requests to
 152 C<bug-acme-dahut-call@rt.cpan.org>, or through the web interface at
 153 L<http://rt.cpan.org>.
 154
 155 =head1 SEE ALSO
 156
 157 L<MooseX::Daemonize>
 158
 159 =head1 AUTHOR
 160
 161 Chris Prather  C<< <perigrin@cpan.org> >>
 162
 163 =head1 LICENCE AND COPYRIGHT
 164
 165 Copyright (c) 2007-2011, Chris Prather C<< <perigrin@cpan.org> >>. All rights reserved.
 166
 167 This module is free software; you can redistribute it and/or
 168 modify it under the same terms as Perl itself. See L<perlartistic>.
 169
 170 =head1 DISCLAIMER OF WARRANTY
 171
 172 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
 173 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
 174 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
 175 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
 176 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 177 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
 178 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
 179 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
 180 NECESSARY SERVICING, REPAIR, OR CORRECTION.
 181
 182 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
 183 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
 184 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
 185 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
 186 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
 187 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
 188 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
 189 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
 190 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
 191 SUCH DAMAGES.
 192
 193 =cut