t/request_mode_heuristics.t

   1 use strictures;
   2
   3 use Test::More 0.88;
   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 }