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 )