Commit | Line | Data |
600ade88 |
1 | #!perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use File::Path; |
7 | use File::Slurp qw(write_file); |
8 | use FindBin; |
9 | use IO::Socket; |
10 | use Test::More; |
11 | |
12 | eval "use Catalyst::Devel 1.0"; |
13 | plan skip_all => 'Catalyst::Devel required' if $@; |
14 | |
15 | eval "use File::Copy::Recursive"; |
16 | plan skip_all => 'File::Copy::Recursive required' if $@; |
17 | |
18 | my $lighttpd_bin = $ENV{LIGHTTPD_BIN} || 'lighttpd'; |
19 | plan skip_all => 'Cannot find lighttpd, please set LIGHTTPD_BIN' |
20 | unless -x $lighttpd_bin; |
21 | |
22 | plan tests => 1; |
23 | |
24 | # clean up |
25 | rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; |
26 | |
27 | # create a TestApp and copy the test libs into it |
28 | mkdir "$FindBin::Bin/../t/tmp"; |
29 | chdir "$FindBin::Bin/../t/tmp"; |
30 | system "perl -I$FindBin::Bin/../lib $FindBin::Bin/../script/catalyst.pl TestApp"; |
31 | chdir "$FindBin::Bin/.."; |
32 | File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' ); |
33 | |
34 | # remove TestApp's tests |
35 | rmtree 't/tmp/TestApp/t'; |
36 | |
37 | # Create a temporary lighttpd config |
38 | my $docroot = "$FindBin::Bin/../t/tmp"; |
39 | my $port = 8529; |
40 | |
41 | # Clean up docroot path |
42 | $docroot =~ s{/t/..}{}; |
43 | |
44 | my $conf = qq{ |
45 | # basic lighttpd config file for testing fcgi+catalyst |
46 | server.modules = ( |
47 | "mod_access", |
48 | "mod_fastcgi", |
49 | "mod_accesslog" |
50 | ) |
51 | |
52 | server.document-root = "$docroot" |
53 | |
54 | server.errorlog = "$docroot/error.log" |
55 | accesslog.filename = "$docroot/access.log" |
56 | |
600ade88 |
57 | server.port = $port |
58 | |
59 | # catalyst app specific fcgi setup |
60 | fastcgi.server = ( |
61 | "" => ( |
62 | "FastCgiTest" => ( |
63 | "socket" => "$docroot/test.socket", |
64 | "check-local" => "disable", |
65 | "bin-path" => "$docroot/TestApp/script/testapp_fastcgi.pl", |
66 | "min-procs" => 1, |
67 | "max-procs" => 1, |
68 | "idle-timeout" => 20 |
69 | ) |
70 | ) |
71 | ) |
72 | }; |
73 | |
74 | write_file "$docroot/lighttpd.conf", $conf; |
75 | |
76 | my $pid = open my $lighttpd, "$lighttpd_bin -D -f $docroot/lighttpd.conf 2>&1 |" |
77 | or die "Unable to spawn lighttpd: $!"; |
78 | |
79 | # wait for it to start |
80 | print "Waiting for server to start...\n"; |
81 | while ( check_port( 'localhost', $port ) != 1 ) { |
82 | sleep 1; |
83 | } |
84 | |
5884ba38 |
85 | exit; |
86 | |
600ade88 |
87 | # run the testsuite against the server |
88 | $ENV{CATALYST_SERVER} = "http://localhost:$port"; |
89 | system( 'prove -r -Ilib/ t/live_*' ); |
90 | |
91 | # shut it down |
92 | kill 'INT', $pid; |
93 | close $lighttpd; |
94 | |
95 | # clean up |
96 | rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; |
97 | |
98 | ok( 'done' ); |
99 | |
100 | sub check_port { |
101 | my ( $host, $port ) = @_; |
102 | |
103 | my $remote = IO::Socket::INET->new( |
104 | Proto => "tcp", |
105 | PeerAddr => $host, |
106 | PeerPort => $port |
107 | ); |
108 | if ($remote) { |
109 | close $remote; |
110 | return 1; |
111 | } |
112 | else { |
113 | return 0; |
114 | } |
115 | } |