lib/Test/MooseX/Daemonize.pm

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