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

##</code><code>##

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;

##</code><code>##

#!/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;

##</code><code>##

package TestServer;
use HTTP::Server::Simple::CGI qw();
use parent 'HTTP::Server::Simple::CGI';
use MyModule;

sub handler {
    MyModule->new->go;
}

1;

##</code><code>##

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