Commit | Line | Data |
c7ded7aa |
1 | # This test tests the standalone server's auto-restart feature. |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
4853fb50 |
6 | use Test::More; |
7 | BEGIN { |
8 | plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP}; |
9 | } |
10 | |
c7ded7aa |
11 | use File::Path; |
12 | use FindBin; |
13 | use LWP::Simple; |
14 | use IO::Socket; |
2f381252 |
15 | use IPC::Open3; |
c7ded7aa |
16 | use Time::HiRes qw/sleep/; |
201464db |
17 | eval {require Catalyst::Devel; Catalyst::Devel->VERSION(1.0);}; |
c7ded7aa |
18 | |
c7ded7aa |
19 | plan skip_all => 'Catalyst::Devel required' if $@; |
9c71d51d |
20 | plan skip_all => 'Catalyst::Devel >= 1.04 required' if $Catalyst::Devel::VERSION <= 1.03; |
c7ded7aa |
21 | eval "use File::Copy::Recursive"; |
22 | plan skip_all => 'File::Copy::Recursive required' if $@; |
23 | |
2f381252 |
24 | my $tmpdir = "$FindBin::Bin/../t/tmp"; |
25 | |
c7ded7aa |
26 | # clean up |
2f381252 |
27 | rmtree $tmpdir if -d $tmpdir; |
c7ded7aa |
28 | |
29 | # create a TestApp and copy the test libs into it |
2f381252 |
30 | mkdir $tmpdir; |
31 | chdir $tmpdir; |
32 | |
201464db |
33 | system( $^X, "-I$FindBin::Bin/../lib", '-MFile::Spec', '-e', "\@ARGV=('TestApp'); my \$devnull = File::Spec->devnull; open my \$fh, '>', \$devnull or die \"Cannot write to \$devnull: \$!\"; *STDOUT = \$fh; do \"$FindBin::Bin/../script/catalyst.pl\""); |
2f381252 |
34 | |
c7ded7aa |
35 | chdir "$FindBin::Bin/.."; |
36 | File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' ); |
37 | |
38 | # remove TestApp's tests |
39 | rmtree 't/tmp/TestApp/t'; |
40 | |
41 | # spawn the standalone HTTP server |
42 | my $port = 30000 + int rand( 1 + 10000 ); |
9c71d51d |
43 | |
2f381252 |
44 | my( $server, $pid ); |
81f25ce6 |
45 | my @cmd = ($^X, "-I$FindBin::Bin/../lib", "-I$FindBin::Bin/lib", |
201464db |
46 | "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '--port', |
47 | $port, '--restart'); |
81f25ce6 |
48 | |
49 | $pid = open3( undef, $server, undef, @cmd ) |
2f381252 |
50 | or die "Unable to spawn standalone HTTP server: $!"; |
c7ded7aa |
51 | |
9c71d51d |
52 | # switch to non-blocking reads so we can fail |
53 | # gracefully instead of just hanging forever |
54 | |
55 | $server->blocking( 0 ); |
56 | |
c7ded7aa |
57 | # wait for it to start |
58 | print "Waiting for server to start...\n"; |
59 | while ( check_port( 'localhost', $port ) != 1 ) { |
60 | sleep 1; |
61 | } |
62 | |
63 | # change various files |
64 | my @files = ( |
65 | "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp.pm", |
66 | "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Action/Begin.pm", |
7d9921b1 |
67 | "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Immutable.pm", |
81f25ce6 |
68 | "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Immutable/HardToReload.pm", |
c7ded7aa |
69 | ); |
70 | |
71 | # change some files and make sure the server restarts itself |
9c71d51d |
72 | NON_ERROR_RESTART: |
c7ded7aa |
73 | for ( 1 .. 20 ) { |
74 | my $index = rand @files; |
75 | open my $pm, '>>', $files[$index] |
76 | or die "Unable to open $files[$index] for writing: $!"; |
77 | print $pm "\n"; |
78 | close $pm; |
79 | |
80 | # give the server time to notice the change and restart |
81 | my $count = 0; |
9c71d51d |
82 | my $line; |
201464db |
83 | while ( ( $line || '' ) !~ /ttempting to restart the server/ ) { |
9c71d51d |
84 | # wait for restart message |
85 | $line = $server->getline; |
86 | sleep 0.1; |
87 | if ( $count++ > 100 ) { |
88 | fail "Server restarted"; |
89 | SKIP: { |
90 | skip "Server didn't restart, no sense in checking response", 1; |
91 | } |
92 | next NON_ERROR_RESTART; |
93 | } |
94 | }; |
95 | pass "Server restarted"; |
96 | |
97 | $count = 0; |
98 | while ( check_port( 'localhost', $port ) != 1 ) { |
c7ded7aa |
99 | # wait for it to restart |
100 | sleep 0.1; |
9c71d51d |
101 | die "Server appears to have died" if $count++ > 100; |
c7ded7aa |
102 | } |
103 | my $response = get("http://localhost:$port/action/default"); |
104 | like( $response, qr/Catalyst::Request/, 'Non-error restart, request OK' ); |
105 | |
9c71d51d |
106 | # give the server some time to reindex its files |
107 | sleep 1; |
c7ded7aa |
108 | } |
109 | |
9c71d51d |
110 | # multiple restart directories |
111 | |
112 | # we need different options so we have to rebuild most |
113 | # of the testing environment |
114 | |
115 | kill 'KILL', $pid; |
116 | close $server; |
117 | |
c7ded7aa |
118 | # clean up |
119 | rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; |
120 | |
201464db |
121 | done_testing; |
122 | |
c7ded7aa |
123 | sub check_port { |
124 | my ( $host, $port ) = @_; |
125 | |
126 | my $remote = IO::Socket::INET->new( |
127 | Proto => "tcp", |
128 | PeerAddr => $host, |
129 | PeerPort => $port |
130 | ); |
131 | if ($remote) { |
132 | close $remote; |
133 | return 1; |
134 | } |
135 | else { |
136 | return 0; |
137 | } |
138 | } |