Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 92 lines (78 sloc) 2.392 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
#!perl
use warnings;
use strict;
use Test::More tests => 31;
use Test::Exception;
use utf8;
use lib 't'; use Utils;

BEGIN { use_ok('Feersum') };

my ($socket,$port) = get_listen_socket();
ok $socket, "made listen socket";
ok $socket->fileno, "has a fileno";

my $evh = Feersum->new();

lives_ok {
    $evh->use_socket($socket);
} 'assigned socket';

my $cb;
{
    my $g = guard { pass "cv recycled"; };
    $cb = sub { $g = $g; fail "old callback" };
}

lives_ok {
    $evh->request_handler($cb);
} "can assign code block";

undef $cb;
pass "after undef cb";

$cb = sub {
    pass "called back!";
    my $r = shift;
    isa_ok $r, 'Feersum::Connection', 'got an object!';
# use Devel::Peek();
# Devel::Peek::Dump($r);
    my $env = $r->env();
    ok $env, "got env";
    is $env->{HTTP_USER_AGENT}, 'FeersumSimpleClient/1.0', 'got a ua!';
    my $utf8 = exists $env->{HTTP_X_UNICODE_PLEASE};
    eval {
        $r->send_response("200 OK", [
            'Content-Type' => 'text/plain'.($utf8 ? '; charset=UTF-8' : ''),
            'Connection' => 'close',
            'X-Client' => 1234,
            'Content-Length' => 666, # should be ignored
        ], $utf8 ? 'Bāz!' : 'Baz!');
    }; warn $@ if $@;
    pass "done request handler";
};

lives_ok {
    $evh->request_handler($cb);
} "can assign another code block";

my $cv = AE::cv;
$cv->begin;

my $w = simple_client GET => '/?qqqqq',
    name => 'ascii',
    timeout => 3,
    sub {
        my ($body, $hdr) = @_;
        is $hdr->{Status}, 200, "client 1 got 200";
        like $hdr->{'x-client'}, qr/^\d+$/, 'got a custom x-client header';
        is $hdr->{'content-length'}, 4, 'content-length was overwritten by the engine';
        is $hdr->{'content-type'}, 'text/plain';
        is $body, 'Baz!', 'plain old body';
        $cv->end;
    };

$cv->begin;
my $w2 = simple_client GET => "/?zzzzz",
    name => 'unicode',
    headers => { 'X-Unicode-Please' => 1 },
    timeout => 3,
    sub {
        my ($body, $hdr) = @_;
        is $hdr->{Status}, 200, "client 2 got 200";
        like $hdr->{'x-client'}, qr/^\d+$/, 'got a custom x-client header';
        is $hdr->{'content-length'}, 5, 'content-length was overwritten by the engine';
        is $hdr->{'content-type'}, 'text/plain; charset=UTF-8';
        is Encode::decode_utf8($body), 'Bāz!', 'unicode body!';
        $cv->end;
    };

$cv->recv;
pass "all done";
Something went wrong with that request. Please try again.