Commit | Line | Data |
7d7115e5 |
1 | use strict; |
3c3db18c |
2 | |
3 | package Test::MooseX::Daemonize; |
7d7115e5 |
4 | use Proc::Daemon; |
3543c999 |
5 | use File::Slurp; |
7d7115e5 |
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[ |
3543c999 |
14 | daemonize_ok |
15 | check_test_output |
7d7115e5 |
16 | ]; |
17 | |
3543c999 |
18 | Sub::Exporter::setup_exporter( |
19 | { |
20 | exports => \@exports, |
21 | groups => { default => \@exports } |
22 | } |
23 | ); |
7d7115e5 |
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 { |
3543c999 |
34 | sleep(1); # Punt on sleep time, 1 seconds should be enough |
35 | $Test->ok( -e $daemon->pidfile, $msg ) |
36 | || $Test->diag( 'Pidfile (' . $daemon->pidfile . ') 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 | } |
7d7115e5 |
63 | } |
64 | } |
65 | |
3c3db18c |
66 | package Test::MooseX::Daemonize::Testable; |
67 | use Moose::Role; |
68 | |
69 | has test_output => ( |
3543c999 |
70 | isa => 'Str', |
71 | is => 'ro', |
3c3db18c |
72 | required => 1, |
73 | ); |
74 | |
75 | after daemonize => sub { |
76 | $Test->use_numbers(0); |
77 | $Test->no_ending(1); |
3543c999 |
78 | open my $out, '>', $_[0]->test_output or die "Cannot open test output: $!"; |
79 | my $fileno = fileno $out; |
80 | open STDERR, ">&=", $fileno |
3c3db18c |
81 | or die "Can't redirect STDERR"; |
82 | |
3543c999 |
83 | open STDOUT, ">&=", $fileno |
3c3db18c |
84 | or die "Can't redirect STDOUT"; |
85 | |
3543c999 |
86 | $Test->output($out); |
87 | $Test->failure_output($out); |
88 | $Test->todo_output($out); |
3c3db18c |
89 | }; |
90 | |
7d7115e5 |
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 | |
3543c999 |
195 | =item daemonize_ok() |
196 | |
197 | =item check_test_output() |
198 | |
7d7115e5 |
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 |
3543c999 |
278 | SUCH DAMAGES. |