Commit | Line | Data |
94d71828 |
1 | #!perl\r |
2 | \r |
3 | # This test tests the standalone server's auto-restart feature.\r |
4 | \r |
5 | use strict;\r |
6 | use warnings;\r |
7 | \r |
8 | use File::Path;\r |
9 | use FindBin;\r |
10 | use LWP::Simple;\r |
11 | use IO::Socket;\r |
12 | use Test::More;\r |
13 | use Time::HiRes qw/sleep/;\r |
14 | eval "use File::Copy::Recursive";\r |
15 | \r |
16 | plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP};\r |
17 | plan skip_all => 'File::Copy::Recursive required' if $@;\r |
18 | \r |
19 | plan tests => 40;\r |
20 | \r |
21 | # clean up\r |
10bdcbe8 |
22 | rmtree "$FindBin::Bin/../../t/tmp" if -d "$FindBin::Bin/../../t/tmp";\r |
94d71828 |
23 | \r |
24 | # create a TestApp and copy the test libs into it\r |
10bdcbe8 |
25 | mkdir "$FindBin::Bin/../../t/tmp";\r |
26 | chdir "$FindBin::Bin/../../t/tmp";\r |
32e231eb |
27 | system "perl -I$FindBin::Bin/../../lib $FindBin::Bin/../../script/catalyst.pl TestApp";\r |
94d71828 |
28 | chdir "$FindBin::Bin/../..";\r |
10bdcbe8 |
29 | File::Copy::Recursive::dircopy( 't/live/lib', 't/tmp/TestApp/lib' );\r |
30 | \r |
31 | # remove TestApp's tests\r |
32 | rmtree 't/tmp/TestApp/t';\r |
94d71828 |
33 | \r |
34 | # spawn the standalone HTTP server\r |
35 | my $port = 30000 + int rand(1 + 10000);\r |
36 | my $pid = open my $server, \r |
10bdcbe8 |
37 | "perl -I$FindBin::Bin/../../lib $FindBin::Bin/../../t/tmp/TestApp/script/testapp_server.pl -port $port -restart 2>&1 |"\r |
94d71828 |
38 | or die "Unable to spawn standalone HTTP server: $!";\r |
39 | \r |
40 | # wait for it to start\r |
41 | print "Waiting for server to start...\n";\r |
42 | while ( check_port( 'localhost', $port ) != 1 ) {\r |
43 | sleep 1;\r |
44 | }\r |
45 | \r |
46 | # change various files\r |
47 | my @files = (\r |
10bdcbe8 |
48 | "$FindBin::Bin/../../t/tmp/TestApp/lib/TestApp.pm",\r |
49 | "$FindBin::Bin/../../t/tmp/TestApp/lib/TestApp/Controller/Action/Begin.pm",\r |
50 | "$FindBin::Bin/../../t/tmp/TestApp/lib/TestApp/Controller/Engine/Request/URI.pm",\r |
94d71828 |
51 | );\r |
52 | \r |
53 | # change some files and make sure the server restarts itself\r |
54 | for ( 1..20 ) {\r |
55 | my $index = rand @files;\r |
56 | open my $pm, '>>', $files[$index]\r |
57 | or die "Unable to open $files[$index] for writing: $!";\r |
58 | print $pm "\n";\r |
59 | close $pm;\r |
60 | \r |
61 | # give the server time to notice the change and restart\r |
62 | my $count = 0;\r |
63 | sleep 1;\r |
64 | while ( check_port( 'localhost', $port ) != 1 ) {\r |
65 | # wait for it to restart\r |
66 | sleep 0.1;\r |
67 | die "Server appears to have died" if $count++ > 50;\r |
68 | }\r |
69 | my $response = get("http://localhost:$port/action/default");\r |
feaf8ea4 |
70 | like( $response, qr/Catalyst::Request/, 'Non-error restart, request OK' );\r |
94d71828 |
71 | \r |
72 | #print $server->getline;\r |
73 | }\r |
74 | \r |
75 | # add errors to the file and make sure server does not die or restart\r |
76 | for ( 1..20 ) {\r |
77 | my $index = rand @files;\r |
78 | open my $pm, '>>', $files[$index]\r |
79 | or die "Unable to open $files[$index] for writing: $!";\r |
80 | print $pm "bleh";\r |
81 | close $pm;\r |
82 | \r |
83 | # give the server time to notice the change\r |
94d71828 |
84 | sleep 1;\r |
85 | if ( check_port( 'localhost', $port ) != 1 ) {\r |
86 | die "Server appears to have died";\r |
87 | }\r |
88 | my $response = get("http://localhost:$port/action/default");\r |
feaf8ea4 |
89 | like( $response, qr/Catalyst::Request/, 'Syntax error, no restart, request OK' );\r |
94d71828 |
90 | \r |
91 | #print $server->getline;\r |
92 | }\r |
93 | \r |
94 | # shut it down\r |
e1b364f4 |
95 | kill 'INT', $pid;\r |
94d71828 |
96 | close $server;\r |
97 | \r |
98 | # clean up\r |
10bdcbe8 |
99 | rmtree "$FindBin::Bin/../../t/tmp" if -d "$FindBin::Bin/../../t/tmp";\r |
94d71828 |
100 | \r |
101 | sub check_port {\r |
102 | my ( $host, $port ) = @_;\r |
103 | \r |
104 | my $remote = IO::Socket::INET->new(\r |
105 | Proto => "tcp",\r |
106 | PeerAddr => $host,\r |
107 | PeerPort => $port\r |
108 | );\r |
109 | if ($remote) {\r |
110 | close $remote;\r |
111 | return 1;\r |
112 | }\r |
113 | else {\r |
114 | return 0;\r |
115 | }\r |
116 | }\r |