lib/Test/MooseX/Daemonize.pm

   1 use strict;
   2
   3 package Test::MooseX::Daemonize;
   4 use Proc::Daemon;
   5 use File::Slurp;
   6
   7 # BEGIN CARGO CULTING
   8 use Sub::Exporter;
   9 use Test::Builder;
  10 our $VERSION   = '0.01';
  11 our $AUTHORITY = 'cpan:PERIGRIN';
  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 our $Test = Test::Builder->new;
  26
  27 sub daemonize_ok {
  28     my ( $daemon, $msg ) = @_;
  29     unless ( my $pid = Proc::Daemon::Fork ) {
  30         $daemon->start();
  31         exit;
  32     }
  33     else {
  34         sleep(1);    # Punt on sleep time, 1 seconds should be enough
  35         $Test->ok( -e $daemon->pidfile->file, $msg )
  36           || $Test->diag( '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 $num = $Test->current_test;
  54             $Test->current_test( ++$num );
  55             $Test->_print("$status $num - $text\n");
  56         }
  57         elsif ( $line =~ s/\A#\s?// ) {
  58             $Test->diag($line);
  59         }
  60         else {
  61             $Test->_print_diag("$label: $line (unrecognised)\n");
  62         }
  63     }
  64 }
  65
  66 package Test::MooseX::Daemonize::Testable;
  67 use Moose::Role;
  68
  69 has test_output => (
  70     isa      => 'Str',
  71     is       => 'ro',
  72     required => 1,
  73 );
  74
  75 after daemonize => sub {
  76     $Test->use_numbers(0);
  77     $Test->no_ending(1);
  78     open my $out, '>', $_[0]->test_output or die "Cannot open test output: $!";
  79     my $fileno = fileno $out;
  80     open STDERR, ">&=", $fileno
  81       or die "Can't redirect STDERR";
  82
  83     open STDOUT, ">&=", $fileno
  84       or die "Can't redirect STDOUT";
  85
  86     $Test->output($out);
  87     $Test->failure_output($out);
  88     $Test->todo_output($out);
  89 };
  90
  91 1;
  92 __END__
  93
  94
  95 =head1 NAME
  96
  97 Test::MooseX::Daemonize - provides a Role that daemonizes your Moose based application.
  98
  99
 100 =head1 VERSION
 101
 102 This document describes MooseX::Daemonize version 0.0.1
 103
 104
 105 =head1 SYNOPSIS
 106
 107     package main;
 108     use Cwd;
 109
 110     ## Try to make sure we are in the test directory
 111     chdir 't' if ( Cwd::cwd() !~ m|/t$| );
 112     my $cwd = Cwd::cwd();
 113
 114     my $file = join( '/', $cwd, 'im_alive' );
 115     my $daemon = FileMaker->new( pidbase => '.', filename => $file );
 116
 117     daemonize_ok( $daemon, 'child forked okay' );
 118     ok( -e $file, "$file exists" );
 119     unlink($file);
 120
 121 =head1 DESCRIPTION
 122
 123 Often you want to write a persistant daemon that has a pid file, and responds appropriately to Signals.
 124 This module helps provide the basic infrastructure to do that.
 125
 126 =head1 ATTRIBUTES
 127
 128 =over
 129
 130 =item progname Str
 131
 132 The name of our daemon, defaults to $0
 133
 134 =item pidbase Str
 135
 136 The base for our bid, defaults to /var/run/$progname
 137
 138 =item pidfile Str
 139
 140 The file we store our PID in, defaults to /var/run/$progname/
 141
 142 =item foreground Bool
 143
 144 If true, the process won't background. Useful for debugging. This option can be set via Getopt's -f.
 145
 146 =back
 147
 148 =head1 METHODS
 149
 150 =over
 151
 152 =item check()
 153
 154 Check to see if an instance is already running.
 155
 156 =item start()
 157
 158 Setup a pidfile, fork, then setup the signal handlers.
 159
 160 =item stop()
 161
 162 Stop the process matching the pidfile, and unlinks the pidfile.
 163
 164 =item restart()
 165
 166 Litterally
 167
 168     $self->stop();
 169     $self->start();
 170
 171 =item daemonize()
 172
 173 Calls C<Proc::Daemon::Init> to daemonize this process.
 174
 175 =item kill($pid)
 176
 177 Kills the process for $pid. This will try SIGINT, and SIGTERM before falling back to SIGKILL and finally giving up.
 178
 179 =item setup_signals()
 180
 181 Setup the signal handlers, by default it only sets up handlers for SIGINT and SIGHUP
 182
 183 =item handle_sigint()
 184
 185 Handle a INT signal, by default calls C<$self->stop()>;
 186
 187 =item handle_sighup()
 188
 189 Handle a HUP signal. Nothing is done by default.
 190
 191 =item meta()
 192
 193 the C<meta()> method from L<Class::MOP::Class>
 194
 195 =item daemonize_ok()
 196
 197 =item check_test_output()
 198
 199 =back
 200
 201 =head1 DEPENDENCIES
 202
 203 =for author to fill in:
 204     A list of all the other modules that this module relies upon,
 205     including any restrictions on versions, and an indication whether
 206     the module is part of the standard Perl distribution, part of the
 207     module's distribution, or must be installed separately. ]
 208
 209 Obviously L<Moose>, also L<Carp>, L<Proc::Daemon>, L<File::Flock>, L<File::Slurp>
 210
 211 =head1 INCOMPATIBILITIES
 212
 213 =for author to fill in:
 214     A list of any modules that this module cannot be used in conjunction
 215     with. This may be due to name conflicts in the interface, or
 216     competition for system or program resources, or due to internal
 217     limitations of Perl (for example, many modules that use source code
 218     filters are mutually incompatible).
 219
 220 None reported.
 221
 222
 223 =head1 BUGS AND LIMITATIONS
 224
 225 =for author to fill in:
 226     A list of known problems with the module, together with some
 227     indication Whether they are likely to be fixed in an upcoming
 228     release. Also a list of restrictions on the features the module
 229     does provide: data types that cannot be handled, performance issues
 230     and the circumstances in which they may arise, practical
 231     limitations on the size of data sets, special cases that are not
 232     (yet) handled, etc.
 233
 234 No bugs have been reported.
 235
 236 Please report any bugs or feature requests to
 237 C<bug-acme-dahut-call@rt.cpan.org>, or through the web interface at
 238 L<http://rt.cpan.org>.
 239
 240 =head1 SEE ALSO
 241
 242 L<Proc::Daemon>, L<Daemon::Generic>, L<MooseX::Getopt>
 243
 244 =head1 AUTHOR
 245
 246 Chris Prather  C<< <perigrin@cpan.org> >>
 247
 248
 249 =head1 LICENCE AND COPYRIGHT
 250
 251 Copyright (c) 2007, Chris Prather C<< <perigrin@cpan.org> >>. All rights reserved.
 252
 253 This module is free software; you can redistribute it and/or
 254 modify it under the same terms as Perl itself. See L<perlartistic>.
 255
 256
 257 =head1 DISCLAIMER OF WARRANTY
 258
 259 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
 260 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
 261 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
 262 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
 263 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 264 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
 265 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
 266 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
 267 NECESSARY SERVICING, REPAIR, OR CORRECTION.
 268
 269 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
 270 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
 271 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
 272 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
 273 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
 274 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
 275 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
 276 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
 277 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
 278 SUCH DAMAGES.