package TestHTTPReq;
use Module::Util qw(find_installed);
use HTTP::Date qw(time2str);
use HTTP::Status;
use HTTP::Response;
use HTTP::Daemon::Threaded::Content;
use base ('HTTP::Daemon::Threaded::Content');
use strict;
use warnings;
our $mtime = time2str((stat(find_installed(__PACKAGE__)))[9]);
sub new { my $class = shift; return $class->SUPER::new(@_); }
sub getContent {
my ($self, $fd, $req, $uri, $params) = ($_[0], $_[1], $_[2], lc $_[3], $_[4]);
#print STDERR "Processing $uri\n";
#
# trim possible leading slash
#
$uri = substr($uri, 1)
if (substr($uri, 0, 1) eq '/');
return $fd->send_error(RC_NOT_FOUND)
unless (($uri eq 'posted') || ($uri eq 'postxml'));
my $html = "\r\n";
my $ct = 'text/html';
if ($uri eq 'posted') {
# print STDERR "posted params:", join(', ', sort keys %$params), "\n";
$html .= "$_ is $$params{$_}
\r\n"
foreach (sort keys %$params);
$html .= "";
}
else {
$ct = 'text/xml';
# print STDERR "posted content: $params \n";
$html = $params; # its the content
}
my $res = HTTP::Response->new(RC_OK, 'OK',
[ 'Content-Type' => $ct,
'Content-Length' => length($html),
'Last-Modified' => $mtime
]);
$res->request($req);
$res->content($html);
return $fd->send_response($res);
}
sub getHeader {
my ($self, $fd, $req, $uri, $params) = ($_[0], $_[1], $_[2], lc $_[3], $_[4]);
#print STDERR "Processing $uri\n";
#
# trim possible leading slash
#
$uri = substr($uri, 1)
if (substr($uri, 0, 1) eq '/');
return $fd->send_error(RC_NOT_FOUND)
unless (($uri eq 'posted') || ($uri eq 'postxml'));
my $html = "\r\n";
my $ct = 'text/html';
if ($uri eq 'posted') {
$html .= "$_ is $$params{$_}
\r\n"
foreach (sort keys %$params);
$html .= "";
}
else {
$ct = 'text/xml';
$html = $params; # its the content
}
my $res = HTTP::Response->new(RC_OK, 'OK',
[ 'Content-Type' => $ct,
'Content-Length' => length($html),
'Last-Modified' => $mtime
]);
$res->request($req);
return $fd->send_response($res);
}
1;