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