Commit | Line | Data |
f11512a9 |
1 | use strictures; |
2 | |
3 | use Test::More; |
4 | use Web::Simple::Application; |
5 | use Socket; |
6 | |
7 | run(); |
8 | done_testing; |
9 | |
10 | sub run { |
11 | |
12 | my $a = Web::Simple::Application->new; |
13 | |
14 | my ( $cli, $cgi, $fcgi, $test ) = qw( cli cgi fcgi test ); |
15 | |
16 | my $res; |
17 | no warnings 'redefine'; |
18 | local *Web::Simple::Application::_run_fcgi = sub { $res = "fcgi" }; |
19 | local *Web::Simple::Application::_run_cgi = sub { $res = "cgi" }; |
20 | local *Web::Simple::Application::_run_cli = sub { $res = "cli" }; |
21 | local *Web::Simple::Application::_run_cli_test_request = sub { $res = "test" }; |
22 | use strictures; |
23 | |
24 | { |
25 | $a->run; |
26 | is $res, "cli", "empty invocation goes to CLI mode"; |
27 | } |
28 | |
29 | SKIP: { |
30 | skip "windows does not support the needed socket manipulation", 2 if $^O eq 'MSWin32' or $^O eq 'cygwin'; |
31 | { |
32 | socket my $socket, AF_INET, SOCK_STREAM, 0 or die "socket: $!"; |
33 | open my $old_in, '<&STDIN' or die "open: $!"; |
34 | open STDIN, '<&', $socket or die "open: $!"; |
35 | $a->run; |
36 | is $res, "fcgi", "STDIN being a socket means FCGI"; |
37 | open STDIN, '<&', $old_in or die "open: $!"; |
38 | } |
39 | |
40 | { |
41 | local $ENV{GATEWAY_INTERFACE} = "CGI 1.1"; |
42 | socket my $socket, AF_INET, SOCK_STREAM, 0 or die "socket: $!"; |
43 | open my $old_in, '<&STDIN' or die "open: $!"; |
44 | open STDIN, '<&', $socket or die "open: $!"; |
45 | $a->run; |
46 | isnt $res, "fcgi", "STDIN being a socket doesn't mean FCGI if GATEWAY_INTERFACE is set"; |
47 | open STDIN, '<&', $old_in or die "open: $!"; |
48 | } |
49 | } |
50 | |
51 | return; |
52 | } |