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