Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

problems with HTTP::Server::Simple::CGI

Hello all. This is a long exposition, but the question at the end is short and salient. I hope here are some experts for the topical module.

I have a CGI program.

#!/usr/bin/perl -T use MyModule; MyModule->new->go;

As you can clearly see, the main code is contained in a module.

package MyModule; use CGI qw(); sub new { my $class = shift; my %self; bless \%self => $class; $self{cgi} = CGI->new; return \%self; } sub go { my $self = shift; if ($self->{cgi}->request_method eq 'POST') { print $self->{cgi} ->header(-Status => 201, -Location => $self->{cgi}->url,); print $self->{cgi}->param('POSTDATA'); } elsif (length $self->{cgi}->path_info > 1) { print $self->{cgi} ->header(-Status => 500, -Content_type => 'text/plain',); print "error"; } else { print $self->{cgi} ->header(-Status => 200, -Content_type => 'application/xml', +); print "<okay />"; } } 1;

I am supposed to test the functionality of the CGI program through the HTTP interface. That means I cannot simply load the module and mess with its methods. Those are all private, so to speak. The HTTP interface is public.

Writing tests for that is easy with LWP. Assume I ship my testing code with a dinky CGI-capable web server of my own instead of relying on the end-user having already set up Apache or something. HTTP::Server::Simple::CGI is the obvious choice for that. The test file looks like this:

#!/usr/bin/perl -T use Test::More tests => 8; use LWP::UserAgent qw(); require 'TestServer.pm'; my $pid = TestServer->new(12345)->background; my $ua = LWP::UserAgent->new; my $r; $r = $ua->request(HTTP::Request->new(GET => 'http://localhost:12345',) +); ok $r->is_success; like $r->header('Content-Type'), qr(^application/xml); $r = $ua->request(HTTP::Request->new(GET => 'http://localhost:12345/pathinfoblahblah',)); ok $r->is_error; like $r->header('Content-Type'), qr(^text/plain); is $r->content, 'error'; my $post_data = 'some post data'; $r = $ua->request(HTTP::Request->new(POST => 'http://localhost:12345', ['Content-Type' => 'application/octet-stream'], $post_data,)); is $r->code, 201; ok $r->header('Location'); is $r->content, $post_data; kill 'KILL', $pid;

The test file loads the test server module.

package TestServer; use HTTP::Server::Simple::CGI qw(); use parent 'HTTP::Server::Simple::CGI'; use MyModule; sub handler { MyModule->new->go; } 1;

This is how I thought it should work. But it does not. The tests fail. When I inspect the server response, the stuff that was printed to the CGI's STDOUT in MyModule ends up wholesale in the HTTP body! LWP makes up a makeshift HTTP header. (Side remark: Ostensibly, LWP speaks HTTP/1.1 to the server, it puzzles me why there's the 0.9 reply.)

diag $r->as_string; # HTTP/0.9 200 Assumed OK # Client-Date: Tue, 17 Feb 2009 01:39:37 GMT # Client-Peer: 127.0.0.1:12345 # Client-r-Num: 1 # # Status: 200 # Content-Type: application/xml # # <okay /> diag $r->as_string; # HTTP/0.9 200 Assumed OK # Client-Date: Tue, 17 Feb 2009 01:40:03 GMT # Client-Peer: 127.0.0.1:12345 # Client-r-Num: 1 # # Status: 500 # Content-Type: text/plain; charset=ISO-8859-1 # # error diag $r->as_string; # HTTP/0.9 200 Assumed OK # Client-Date: Tue, 17 Feb 2009 01:40:32 GMT # Client-Peer: 127.0.0.1:12345 # Client-r-Num: 1 # # Status: 201 # Location: http://localhost:12345 # Content-Type: text/html; charset=ISO-8859-1 # # some post data

The error lies clearly in TestServer, because when I modify the test program to interact with the CGI program on Apache, everything works. Additional observation (no idea whether this is significant): either CGI.pm when running under Apache or Apache itself turns the HTTP 'Status' header into the appropriate status line that is initial to each response, e.g. 'HTTP/1.1 200 OK'; this feature is missing from the interaction with HTTP::Server::Simple::CGI.

The question: how does TestServer need to be changed so that my tests pass?

Replies are listed 'Best First'.
Re: problems with HTTP::Server::Simple::CGI
by almut (Canon) on Feb 17, 2009 at 03:16 UTC
Re: problems with HTTP::Server::Simple::CGI
by Corion (Patriarch) on Feb 18, 2009 at 13:25 UTC

    I'm currently writing a module, Test::WWW::Mechanize::HSSCGI, which will dry-test a HTTP::Server::Simple::CGI server without needing network and/or sockets. While looking for it, I found Test::WWW::Mechanize::CGI, which seems to be just what you need, a WWW::Mechanize that knows how to talk to a CGI backend without having to have a webserver. So maybe you can use that, or the methods employed by it.

Re: problems with HTTP::Server::Simple::CGI
by Anonymous Monk on Feb 17, 2009 at 03:12 UTC

      I see it prints HTTP headers with the status line first. So I changed the handler to work around that. I capture the output that has been written through CGI STDOUT, then mangle the headers and print that.

      sub handler { capture { MyModule->new->go; } \$out; my ($header, $body) = split /\r\n\r\n/, $out, 2; my $h = HTTP::Headers->new; for my $line (split /\r\n/, $header) { my ($key, $value) = split /: /, $line, 2; $h->header($key, $value); } $h->header('Status' => 200) unless $h->header('Status'); my $status = $h->header('Status'); $h->remove_header('Status'); print 'HTTP/1.1 ' . HTTP::Response->new($status => undef, $h, $body)->as_string("\ +r\n"); }

      Now the tests pass, except the last one! That's the one about POST data. Thus:

      is $r->content, $post_data; # Failed test at foobar.t line 85. # got: '' # expected: 'some post data' # Looks like you failed 1 test of 8.
      diag $r->as_string shows:
      # HTTP/1.1 201 Created # Location: http://localhost:12345 # Content-Type: text/html; charset=ISO-8859-1 # Client-Aborted: die # Client-Date: Tue, 17 Feb 2009 18:16:12 GMT # Client-Response-Num: 1 # X-Died: read failed: Connection reset by peer at .../LWP/Protocol/ht +tp.pm line 382, <DATA> line 16. #

      Note that the transmitted HTTP body disappeared. I can confirm that it does not arrive anymore by the time CGI is initialised. I can confirm that the capturing causes that.

      What do I do now?

        Now you fix it ?:) Sorry, I've never heard of capture, so can't guess what you're doing wrong :) Maybe you're closing the connection prematurely? ( die "oh noes")