lib/Test/MooseX/Daemonize.pm

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