BEGIN {
push @INC, './t';
print STDERR "*** Note: delays of several seconds may occur during these tests\n";
print STDERR "*** Note2: several harmless \"Scalars leaked\" messages may be reported\n";
}
use Test::More tests => 10;
use LWP::Simple;
use LWP::UserAgent;
use LWPBulkFetch;
use strict;
use warnings;
#
# forks a child to run system('perl somescript.pl'),
# which this process monitors
#
my $child1;
my $sep = ($^O eq 'MSWin32') ? '\\' : '/';
unless ($ARGV[0]) {
$child1 = fork();
die "Can't fork HTTP Client child: $!" unless defined $child1;
unless ($child1) {
my $cmd = 'perl -w t' . $sep . 'cgidtest.pl -p 11876 -c 5 -d ./t -l 1 -s';
system($cmd);
exit 1;
}
#
# wait a while for things to get rolling
#
sleep 5;
}
my $index = 'Some really simple HTML.';
my ($ct, $cl, $mtime, $exp, $server);
#
# now run each LWP request and see what we get back
#
# 1. simple HEAD
#
my $indexlen = length($index); # change this!
($ct, $cl, $mtime, $exp, $server) = head('http://localhost:11876/index.html');
ok((defined($ct) && ($ct eq 'text/html') &&
defined($cl) && ($cl == $indexlen)), 'simple HEAD');
#
# 2. simple GET
#
my $page = get 'http://localhost:11876';
ok((defined($page) && ($page eq $index)), 'simple GET');
#
# 3. document HEAD
#
my $jspage = '/*
this would normally be a nice piece of javascript
*/
';
($ct, $cl, $mtime, $exp, $server) = head('http://localhost:11876/scripty.js');
ok((defined($ct) && ($ct eq 'text/javascript') &&
defined($cl) && (($cl == crlen($jspage)) || ($cl == length($jspage)))),
'document HEAD');
#
# 4. CGI HEAD
#
my $postpg = <<'EOPAGE';
Untitled Document
that is other
this is some
when is right this minute
where is up
EOPAGE
($ct, $cl, $mtime, $exp, $server) = head('http://localhost:11876/posted?this=some&that=other&where=up&when=right%20this%20minute');
#print STDERR "head returns ", join(",", $ct, $mtime, $exp, $server), "\n";
ok((defined($ct) && ($ct eq 'text/html; charset=UTF-8')), 'document HEAD');
# 5. document GET
#
$page = get 'http://localhost:11876/scripty.js';
ok((defined($page) && (!crcmp($page, $jspage))), 'document GET');
#
# 6. CGI GET
#
$page = get 'http://localhost:11876/posted?this=some&that=other&where=up&when=right%20this%20minute';
ok((defined($page) && (!crcmp($page, $postpg))), 'CGI GET');
#
# 7. multidoc GET
#
my %multidoc = (
'http://localhost:11876/frames.html',
"
Test Content Handler
",
'http://localhost:11876/stackpane.html',
'
Some other stuff goes here...
',
'http://localhost:11876/sourcepane.html',
'
Here\'s a frame
',
'http://localhost:11876/sourcetree.html',
'
'
);
my $fetched = LWPBulkFetch->new('http://localhost:11876/frames.html');
my $url;
if ($fetched) {
my $ok = 1;
while (($url, $page) = each %multidoc) {
$ok = undef, last
unless $fetched->{$url} && (!crcmp($page, $fetched->{$url}));
}
ok($ok, 'multidoc GET');
}
else {
fail('multidoc GET');
}
#
# 8. simple POST
#
my $ua = LWP::UserAgent->new();
$page = $ua->post('http://localhost:11876/posted',
{ this => 'some', that => 'other', where => 'up', when => 'right this minute'});
unless (defined $page) {
fail('simple POST');
}
else {
$page = $page->content();
ok((defined($page) && (!crcmp($page, $postpg))), 'simple POST');
}
#
# 9. POST w/ content
#
my $xml =
'
this is the second
this is the third
';
my $r = HTTP::Request->new( POST => 'http://localhost:11876/postxml' );
$r->content( $xml );
$r->header('Content-type' => 'text/xml');
my $response = $ua->request( $r );
$page = $response->is_success ? $response->content : undef;
ok((defined($page) && (!crcmp($page, $xml))), 'POST w/ content');
SKIP:
{
#
# 10. PUT (er, not yet...)
#
skip 'Not ready for PUT yet...', 1;
}
get 'http://localhost:11876/stop';
unless ($ARGV[0]) {
kill($child1);
waitpid($child1, 0);
}
sub crlen {
my $crs = ($_[0]=~tr/\n//);
return length($_[0]) + $crs;
}
sub crcmp {
$_[0]=~s/[\r\n]//g;
$_[1]=~s/[\r\n]//g;
return ($_[0] cmp $_[1]);
}