File Coverage

blib/lib/Catalyst/Engine/HTTP/Restarter.pm
Criterion Covered Total %
statement 15 38 39.5
branch 0 10 0.0
condition 0 10 0.0
subroutine 5 6 83.3
pod 1 1 100.0
total 21 65 32.3


line stmt bran cond sub pod time code
1             package Catalyst::Engine::HTTP::Restarter;
2              
3 1     1   15 use strict;
  1         9  
  1         21  
4 1     1   16 use warnings;
  1         10  
  1         17  
5 1     1   16 use base 'Catalyst::Engine::HTTP';
  1         10  
  1         17  
6 1     1   16 use Catalyst::Engine::HTTP::Restarter::Watcher;
  1         9  
  1         29  
7 1     1   17 use NEXT;
  1         8  
  1         18  
8              
9             sub run {
10 0     0 1       my ( $self, $class, $port, $host, $options ) = @_;
11              
12 0   0           $options ||= {};
13              
14             # Setup restarter
15 0 0             unless ( my $restarter = fork ) {
16              
17             # Prepare
18 0                   close STDIN;
19 0                   close STDOUT;
20              
21 0   0               my $watcher = Catalyst::Engine::HTTP::Restarter::Watcher->new(
22                         directory => (
23                             $options->{restart_directory} ||
24                             File::Spec->catdir( $FindBin::Bin, '..' )
25                         ),
26                         regex => $options->{restart_regex},
27                         delay => $options->{restart_delay},
28                     );
29              
30 0   0               $host ||= '127.0.0.1';
31 0                   while (1) {
32              
33             # poll for changed files
34 0                       my @changed_files = $watcher->watch();
35              
36             # check if our parent process has died
37 0 0 0                   exit if $^O ne 'MSWin32' and getppid == 1;
38              
39             # Restart if any files have changed
40 0 0                     if (@changed_files) {
41 0                           my $files = join ', ', @changed_files;
42 0                           print STDERR qq/File(s) "$files" modified, restarting\n\n/;
43              
44 0                           require IO::Socket::INET;
45 0                           require HTTP::Headers;
46 0                           require HTTP::Request;
47              
48 0 0                         my $client = IO::Socket::INET->new(
49                                 PeerAddr => $host,
50                                 PeerPort => $port
51                               )
52                               or die "Can't create client socket (is server running?): ",
53                               $!;
54              
55             # build the Kill request
56 0                           my $req =
57                               HTTP::Request->new( 'RESTART', '/',
58                                 HTTP::Headers->new( 'Connection' => 'close' ) );
59 0                           $req->protocol('HTTP/1.0');
60              
61 0 0                         $client->send( $req->as_string )
62                               or die "Can't send restart instruction: ", $!;
63 0                           $client->close();
64 0                           exit;
65                         }
66                     }
67                 }
68              
69 0               return $self->NEXT::run( $class, $port, $host, $options );
70             }
71              
72             1;
73             __END__
74            
75             =head1 NAME
76            
77             Catalyst::Engine::HTTP::Restarter - Catalyst Auto-Restarting HTTP Engine
78            
79             =head1 SYNOPSIS
80            
81             script/myapp_server.pl -restart
82            
83             =head1 DESCRIPTION
84            
85             The Restarter engine will monitor files in your application for changes
86             and restart the server when any changes are detected.
87            
88             =head1 METHODS
89            
90             =head2 run
91            
92             =head1 SEE ALSO
93            
94             L<Catalyst>, L<Catalyst::Engine::HTTP>, L<Catalyst::Engine::CGI>,
95             L<Catalyst::Engine>.
96            
97             =head1 AUTHORS
98            
99             Sebastian Riedel, <sri@cpan.org>
100            
101             Dan Kubb, <dan.kubb-cpan@onautopilot.com>
102            
103             Andy Grundman, <andy@hybridized.org>
104            
105             =head1 THANKS
106            
107             Many parts are ripped out of C<HTTP::Server::Simple> by Jesse Vincent.
108            
109             =head1 COPYRIGHT
110            
111             This program is free software, you can redistribute it and/or modify it under
112             the same terms as Perl itself.
113            
114             =cut
115