Assume FastCGI mode if STDIN is a socket (works some places env vars fail)

[catagits/Web-Simple.git] / lib / Web / Simple / Application.pm

diff --git a/lib/Web/Simple/Application.pm b/lib/Web/Simple/Application.pm
index 92fbca0..235b871 100644 (file)
--- a/lib/Web/Simple/Application.pm
+++ b/lib/Web/Simple/Application.pm
@@ -62,25 +62,52 @@ sub to_psgi_app {
 
 sub run {
   my $self = shift;
-  if ($ENV{PHP_FCGI_CHILDREN} || $ENV{FCGI_ROLE} || $ENV{FCGI_SOCKET_PATH}) {
+  if (
+    $ENV{PHP_FCGI_CHILDREN} || $ENV{FCGI_ROLE} || $ENV{FCGI_SOCKET_PATH}
+    || -S STDIN # STDIN is a socket, almost certainly FastCGI
+    ) {
     return $self->_run_fcgi;
   } elsif ($ENV{GATEWAY_INTERFACE}) {
     return $self->_run_cgi;
   }
-  unless (@ARGV && $ARGV[0] =~ m{^/}) {
+  unless (@ARGV && $ARGV[0] =~ m{^[A-Z/]}) {
     return $self->_run_cli(@ARGV);
   }
 
-  my $path = shift @ARGV;
+  my @args = @ARGV;
 
-  require HTTP::Request::Common;
+  unshift(@args, 'GET') if $args[0] =~ m{^/};
+
+  $self->_run_test_request(@args);
+}
+
+sub _run_test_request {
+  my ($self, $method, $path, @rest) = @_;
+
+  require HTTP::Request;
   require Plack::Test;
-  local *GET = \&HTTP::Request::Common::GET;
 
-  my $request = GET($path);
+  my $request = HTTP::Request->new($method => $path);
+  if ($method eq 'POST' or $method eq 'PUT' and @rest) {
+    my $content = do {
+      require URI;
+      my $url = URI->new('http:');
+      $url->query_form(@rest);
+      $url->query;
+    };
+    $request->header('Content-Type' => 'application/x-www-form-urlencoded');
+    $request->header('Content-Length' => length($content));
+    $request->content($content);
+  }
   my $response;
-  Plack::Test::test_psgi($self->to_psgi_app, sub { $response = shift->($request) });
-  print $response->as_string;
+  Plack::Test::test_psgi(
+    $self->to_psgi_app, sub { $response = shift->($request) }
+  );
+  print STDERR $response->status_line."\n";
+  print STDERR $response->headers_as_string("\n")."\n";
+  my $content = $response->content;
+  $content .= "\n" if length($content) and $content !~ /\n\z/;
+  print STDOUT $content if $content;
 }
 
 sub _run_cli {
@@ -249,22 +276,12 @@ useful for testing:
     my $c = HTTP::Request::AsCGI->new(@args)->setup;
     $app->run;
 
-=head1 AUTHOR
-
-Matt S. Trout <mst@shadowcat.co.uk>
-
-=head1 CONTRIBUTORS
-
-None required yet. Maybe this module is perfect (hahahahaha ...).
-
-=head1 COPYRIGHT
+=head1 AUTHORS
 
-Copyright (c) 2010 the Web::Simple L</AUTHOR> and L</CONTRIBUTORS>
-as listed above.
+See L<Web::Simple> for authors.
 
-=head1 LICENSE
+=head1 COPYRIGHT AND LICENSE
 
-This library is free software and may be distributed under the same terms
-as perl itself.
+See L<Web::Simple> for the copyright and license.
 
 =cut