improved CGI tests

mojolicious · Sep 11, 2011 · e35d1d8 · e35d1d8
1 parent a1a16bb
commit e35d1d8
Show file tree

Hide file tree

Showing 4 changed files with 104 additions and 142 deletions.
diff --git a/lib/Mojo/Server/CGI.pm b/lib/Mojo/Server/CGI.pm
@@ -22,13 +22,14 @@ sub run {
 
   # Request body
   while (!$req->is_done) {
-    my $read = STDIN->sysread(my $buffer, CHUNK_SIZE, 0);
+    my $read = STDIN->read(my $buffer, CHUNK_SIZE, 0);
     last unless $read;
     $req->parse($buffer);
   }
 
   # Handle
   $self->on_request->($self, $tx);
+  STDOUT->autoflush(1);
 
   # Response start line
   my $res    = $tx->res;
@@ -48,21 +49,16 @@ sub run {
 
       # Start line
       return unless STDOUT->opened;
-      my $written = STDOUT->syswrite($chunk);
-      return unless defined $written;
-      $offset += $written;
+      print STDOUT $chunk;
+      $offset += length $chunk;
     }
   }
 
-  # Fix headers
+  # Response headers
   $res->fix_headers;
-
-  # Status
   my $code    = $res->code    || 404;
   my $message = $res->message || $res->default_message;
   $res->headers->header(Status => "$code $message") unless $self->nph;
-
-  # Response headers
   $offset = 0;
   while (1) {
     my $chunk = $res->get_header_chunk($offset);
@@ -78,9 +74,8 @@ sub run {
 
     # Headers
     return unless STDOUT->opened;
-    my $written = STDOUT->syswrite($chunk);
-    return unless defined $written;
-    $offset += $written;
+    print STDOUT $chunk;
+    $offset += length $chunk;
   }
 
   # Response body
@@ -99,9 +94,8 @@ sub run {
 
     # Content
     return unless STDOUT->opened;
-    my $written = STDOUT->syswrite($chunk);
-    return unless defined $written;
-    $offset += $written;
+    print STDOUT $chunk;
+    $offset += length $chunk;
   }
 
   # Finish transaction

diff --git a/lib/Mojolicious/Routes/Match.pm b/lib/Mojolicious/Routes/Match.pm
@@ -121,6 +121,9 @@ sub match {
   return $self;
 }
 
+# "I'm not a robot!
+#  I don't like having discs crammed into me, unless they're Oreos.
+#  And then, only in the mouth."
 sub path_for {
   my $self   = shift;
   my $values = {};

diff --git a/t/mojo/apache_cgi.t b/t/mojo/apache_cgi.t
diff --git a/t/mojo/cgi.t b/t/mojo/cgi.t
@@ -1,15 +1,105 @@
 #!/usr/bin/env perl
 use Mojo::Base -strict;
 
-use Test::More tests => 2;
+use Test::More tests => 17;
+
+use Mojo::Message::Response;
 
 # "My ears are burning.
 #  I wasn't talking about you, Dad.
 #  No, my ears are really burning. I wanted to see inside, so I lit a Q-tip."
 use_ok 'Mojo::Server::CGI';
+use_ok 'Mojolicious::Command::cgi';
 
-my $cgi = Mojo::Server::CGI->new;
+# Simple
+my $message = '';
+{
+  local *STDOUT;
+  open STDOUT, '>', \$message;
+  local %ENV = (
+    PATH_INFO       => '/',
+    REQUEST_METHOD  => 'GET',
+    SCRIPT_NAME     => '/',
+    HTTP_HOST       => 'localhost:8080',
+    SERVER_PROTOCOL => 'HTTP/1.0'
+  );
+  Mojolicious::Command::cgi->new->run;
+}
+my $res =
+  Mojo::Message::Response->new->parse("HTTP/1.1 200 OK\x0d\x0a$message");
+is $res->code, 200, 'rigth status';
+is $res->headers->content_type, 'text/html;charset=UTF-8',
+  'right "Content-Type" value';
+like $res->body, qr/Mojo/, 'right content';
+
+# Non-parsed headers
+$message = '';
+{
+  local *STDOUT;
+  open STDOUT, '>', \$message;
+  local %ENV = (
+    PATH_INFO       => '/',
+    REQUEST_METHOD  => 'GET',
+    SCRIPT_NAME     => '/',
+    HTTP_HOST       => 'localhost:8080',
+    SERVER_PROTOCOL => 'HTTP/1.0'
+  );
+  Mojolicious::Command::cgi->new->run('--nph');
+}
+$res = Mojo::Message::Response->new->parse($message);
+is $res->code, 200, 'rigth status';
+is $res->headers->content_type, 'text/html;charset=UTF-8',
+  'right "Content-Type" value';
+like $res->body, qr/Mojo/, 'right content';
+
+# Chunked
+my $content = 'test1=1&test2=2&test3=3&test4=4&test5=5&test6=6&test7=7';
+$message = '';
+{
+  local *STDIN;
+  open STDIN, '<', \$content;
+  local *STDOUT;
+  open STDOUT, '>', \$message;
+  local %ENV = (
+    PATH_INFO       => '/diag/chunked_params',
+    CONTENT_LENGTH  => length($content),
+    CONTENT_TYPE    => 'application/x-www-form-urlencoded',
+    REQUEST_METHOD  => 'POST',
+    SCRIPT_NAME     => '/',
+    HTTP_HOST       => 'localhost:8080',
+    SERVER_PROTOCOL => 'HTTP/1.0'
+  );
+  Mojolicious::Command::cgi->new->run;
+}
+like $message, qr/chunked/, 'is chunked';
+$res = Mojo::Message::Response->new->parse("HTTP/1.1 200 OK\x0d\x0a$message");
+is $res->code, 200,       'rigth status';
+is $res->body, '1234567', 'right content';
+
+# Parameters
+$message = '';
+{
+  local *STDOUT;
+  open STDOUT, '>', \$message;
+  local %ENV = (
+    PATH_INFO       => '/diag/dump_params',
+    QUERY_STRING    => 'lalala=23&bar=baz',
+    REQUEST_METHOD  => 'GET',
+    SCRIPT_NAME     => '/',
+    HTTP_HOST       => 'localhost:8080',
+    SERVER_PROTOCOL => 'HTTP/1.0'
+  );
+  Mojolicious::Command::cgi->new->run;
+}
+$res = Mojo::Message::Response->new->parse("HTTP/1.1 200 OK\x0d\x0a$message");
+is $res->code, 200, 'rigth status';
+is $res->headers->content_type, 'application/json',
+  'right "Content-Type" value';
+is $res->headers->content_length, 27, 'right "Content-Length" value';
+is $res->json->{lalala}, 23,    'right value';
+is $res->json->{bar},    'baz', 'right value';
 
 # Test closed STDOUT
+my $cgi = Mojo::Server::CGI->new;
 close(STDOUT);
 ok((not defined $cgi->run), 'working with closed STDOUT');