POE-Component-Server-HTTP
view release on metacpan or search on metacpan
t/20_stream.t view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use Test::More tests => 13;
use LWP::UserAgent;
use HTTP::Request;
use POE::Kernel;
use POE::Component::Server::HTTP;
use YAML;
my $PORT = 2081;
my $pid = fork;
die "Unable to fork: $!" unless defined $pid;
END {
if ($pid) {
kill 2, $pid or warn "Unable to kill $pid: $!";
}
}
$|++;
####################################################################
if ($pid) { # we are parent
# stop kernel from griping
${$poe_kernel->[POE::Kernel::KR_RUN]} |=
POE::Kernel::KR_RUN_CALLED;
print STDERR "$$: Sleep 2...";
sleep 2;
print STDERR "continue\n";
if(@ARGV) {
print STDERR "Please connect to http://localhost:$PORT/ with your browser and make sure everything works\n";
local @ARGV=();
{} while <>;
}
my $UA = LWP::UserAgent->new;
##################################### welcome
my $req=HTTP::Request->new(GET => "http://localhost:$PORT/");
my $resp=$UA->request($req);
ok(($resp->is_success and $resp->content_type eq 'text/html'),
"got index") or die "resp=", Dump $resp;
my $content = $resp->content;
ok(($content =~ /multipart.txt/), "proper index")
or die "resp=", Dump $content;
##################################### last.txt
$req=HTTP::Request->new(GET => "http://localhost:$PORT/last.txt");
$resp=$UA->request($req);
ok(($resp->is_success and $resp->content_type eq 'text/plain'),
"got last.txt") or die "resp=", Dump $resp;
$content = $resp->content;
ok(($content =~ /everything worked/), "everything worked")
or die "resp=", Dump $content;
##################################### multipart.txt
$req=HTTP::Request->new(GET => "http://localhost:$PORT/multipart.txt");
$resp=$UA->request($req);
ok(($resp->is_success and $resp->content_type =~ m(^multipart/mixed)),
"got multipart.txt") or die "resp=", Dump $resp;
$content = $resp->content;
ok(($content =~ /everything worked/), "everything worked")
or die "resp=", Dump $content;
##################################### last.gif
my $last = File::Basename::dirname($0).'/last.gif';
open LAST, $last or die "Unable to open $last: $!";
{
local $/;
$last = <LAST>;
}
close LAST;
##################################### last.gif
$req=HTTP::Request->new(GET => "http://localhost:$PORT/last.gif");
$resp=$UA->request($req);
ok(($resp->is_success and $resp->content_type eq 'image/gif'),
"got last.gif") or die "resp=", Dump $resp;
$content = $resp->content;
ok(($content eq $last), "everything worked");
##################################### multipart.gif
$req=HTTP::Request->new(GET => "http://localhost:$PORT/multipart.gif");
$resp=$UA->request($req);
ok(($resp->is_success and $resp->content_type =~ m(^multipart/mixed)),
"got multipart.txt") or die "resp=", Dump $resp;
( run in 0.962 second using v1.01-cache-2.11-cpan-0d23b851a93 )