Feersum

 view release on metacpan or  search on metacpan

Feersum.xs  view on Meta::CPAN

            continue;
        }
        else if (unlikely(str_case_eq(
            STR_WITH_LEN("content-length"), hdr->name, hdr->name_len)))
        {
            // content length shouldn't show up as HTTP_CONTENT_LENGTH but
            // as CONTENT_LENGTH in the env-hash.
            continue;
        }
        else if (unlikely(str_case_eq(
            STR_WITH_LEN("content-type"), hdr->name, hdr->name_len)))
        {
            hv_stores(e, "CONTENT_TYPE",newSVpvn(hdr->value, hdr->value_len));
            continue;
        }

        size_t klen = 5+hdr->name_len;
        if (kbuflen < klen) {
            kbuflen = klen;
            kbuf = Renew(kbuf, kbuflen, char);
        }

lib/Feersum/Connection.pm  view on Meta::CPAN

input body handler (psgi.input), it is advised to close it after read is done

=item C<< my $env = $req->headers([normalization_style]) >>

an array of headers if form of [name, value, name, value, ...]

normalization_style is one of:

0 - skip normalization (default)
HEADER_NORM_LOCASE - "content-type"
HEADER_NORM_UPCASE - "CONTENT-TYPE"
HEADER_NORM_LOCASE_DASH - "content_type"
HEADER_NORM_UPCASE_DASH - "CONTENT_TYPE" (like PSGI, but without "HTTP_" prefix)

One can export these constants via c<<use Feersum 'HEADER_NORM_LOCASE'>>

=item C<< my $value = $req->header(name) >>

simple lookup for header value, name should be in lowercase, eg. 'content-type'

=item C<< my $env = $req->remote_address >>

remote address (psgi REMOTE_ADDR)

=item C<< my $env = $req->remote_port >>

remote port (psgi REMOTE_PORT)

=back

t/01-simple.t  view on Meta::CPAN

$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';
        like $hdr->{'date'}, qr/^(Mon|Tue|Wed|Thu|Fri|Sat|Sun), \d{2} (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec) \d{4} \d{2}:\d{2}:\d{2} GMT$/, 'got date header';
        note($hdr->{'date'});
        is Encode::decode_utf8($body), 'Bāz!', 'unicode body!';
        $cv->end;
    };

$cv->recv;
pass "all done";

t/02-array-body.t  view on Meta::CPAN

    $evh->use_socket($socket);
}, undef, 'assigned socket';

my $cv = AE::cv;
$cv->begin;
my $w = simple_client GET => '/?blar',
    timeout => 3,
    sub {
        my ($body, $headers) = @_;
        is $headers->{Status}, 200, "client got 200";
        is $headers->{'content-type'}, 'text/plain; charset=UTF-8';

        $body = Encode::decode_utf8($body) unless Encode::is_utf8($body);

        is $headers->{'content-length'}, bytes::length($body),
            'content-length was calculated correctly';

        is $body, 'this should be cøncātenated.',
            'body was concatenated together';
        $cv->end;
    };

t/03-env-hash.t  view on Meta::CPAN

}, undef, 'assigned socket';

my $cv = AE::cv;
$cv->begin;
my $w = simple_client GET => "/what%20is%20wrong%3f?blar",
    headers => {'x-test-num' => 1, 'Referer' => '/wrong'},
    timeout => 3,
sub {
    my ($body, $headers) = @_;
    is $headers->{Status}, 200, "client 1 got 200";
    is $headers->{'content-type'}, 'text/plain; charset=UTF-8';

    $body = Encode::decode_utf8($body) unless Encode::is_utf8($body);

    is $headers->{'content-length'}, bytes::length($body),
        'client 1 content-length was calculated correctly';

    is $body, "Oh Hai 1\n", 'client 1 expected body';
    $cv->end;
};

$cv->begin;
my $w2 = simple_client GET => "/what%%20is%20good%3F%2?dlux=sonice", 
    headers => {'x-test-num' => 2, 'Referer' => 'good'},
    timeout => 3,
sub {
    my ($body, $headers) = @_;
    is $headers->{Status}, 200, "client 2 got 200";
    is $headers->{'content-type'}, 'text/plain; charset=UTF-8';

    $body = Encode::decode_utf8($body) unless Encode::is_utf8($body);

    is $headers->{'content-length'}, bytes::length($body),
        'client 2 content-length was calculated correctly';

    is $body, "Oh Hai 2\n", 'client 2 expected body';
    $cv->end;
};

$cv->begin;
my $w3 = simple_client GET => "/no%20query",
    headers => {'x-test-num' => 3, 'Referer' => 'ugly'},
    timeout => 3,
sub {
    my ($body, $headers) = @_;
    is $headers->{Status}, 200, "client 3 got 200";
    is $headers->{'content-type'}, 'text/plain; charset=UTF-8';

    $body = Encode::decode_utf8($body) unless Encode::is_utf8($body);

    is $headers->{'content-length'}, bytes::length($body),
        'client 3 content-length was calculated correctly';

    is $body, "Oh Hai 3\n", 'client 3 expected body';
    $cv->end;
};

$cv->begin;
my $w4 = simple_client GET => "/no spaces allowed",
    headers => {'x-test-num' => 4, 'Referer' => 'ugly'},
    timeout => 3,
sub {
    my ($body, $headers) = @_;
    is $headers->{Status}, 400, 'client 4 Bad Request';
    is $headers->{Reason}, "Bad Request";
    is $headers->{'content-type'}, 'text/plain';
    is $body, "Malformed request.\n", 'client 4 expected error';
    $cv->end;
};

$cv->begin;
my $w5 = simple_client POST => "/post",
    headers => {
        'x-test-num' => 5,
        'Content-Type' => 'text/plain; charset=US-ASCII',
    },
    body => "The post\n",
    timeout => 3,
sub {
    my ($body, $headers) = @_;
    is $headers->{Status}, 200, "client 5 got 200";
    is $headers->{'content-type'}, 'text/plain; charset=UTF-8';

    $body = Encode::decode_utf8($body) unless Encode::is_utf8($body);

    is $headers->{'content-length'}, bytes::length($body),
        'client 5 content-length was calculated correctly';

    is $body, "Oh Hai 5\n", 'client 5 expected body';
    $cv->end;
};

t/04-died.t  view on Meta::CPAN

is exception {
    $evh->use_socket($socket);
}, undef, 'assigned socket';

my $cv = AE::cv;
$cv->begin;
my $w = simple_client GET => "/?blar", timeout => 3, sub {
    my ($body, $headers) = @_;
    is $headers->{Status}, 500, "client got 500";
    is $headers->{'content-type'}, 'text/plain';
    is $body, "Request handler exception.\n", 'got expected body';
    $cv->end;
};

$cv->recv;
pass "all done";

t/10-respond-304.t  view on Meta::CPAN

}, undef, 'assigned socket';

my $cv = AE::cv;
$cv->begin;
my $w = simple_client GET => '/?blef',
    headers => { 'X-Client' => 1 },
    timeout => 3,
    sub {
        my ($body, $headers) = @_;
        is $headers->{Status}, 304, "client got 304";
        ok !exists $headers->{'content-type'}, 'missing c-t';
        # 304 not-modifieds shouldn't auto-generate a content-length header or
        # any other "entity" headers.  These reflect the actual entity, and
        # can update cache's respresentation of the object.
        ok !exists $headers->{'content-length'},'no c-l generated';
        ok !$body, 'no body';
        $cv->end;
    };

$cv->begin;
my $w2 = simple_client GET => '/?blef',
    headers => { 'X-Client' => 2 },
    timeout => 3,
    sub {
        my ($body, $headers) = @_;
        is $headers->{Status}, 304, "2nd client got 304";
        ok !exists $headers->{'content-type'}, 'missing c-t';
        # If the app specified a C-L, we should respect it for the same
        # reasons.
        is $headers->{'content-length'}, 123, 'c-l not replaced';
        ok !$body, 'no body';
        $cv->end;
    };

$cv->recv;
pass "all done";

t/50-psgi-simple.t  view on Meta::CPAN

my $cv = AE::cv;

for my $n (1 .. CLIENTS) {
    $cv->begin;
    my $h; $h = simple_client GET => '/',
        name => "($n)",
    sub {
        my ($body, $headers) = @_;
        is $headers->{'Status'}, 200, "($n) Response OK";
        is $headers->{'content-type'}, 'text/plain', "... ($n) is text";
        is $body, 'Hello World', "... ($n) correct body";
        $cv->end;
        undef $h;
    };
}

$cv->recv;
pass "all done";

t/51-psgi-streaming.t  view on Meta::CPAN

ok $app, 'got an app' || diag $@;
$evh->psgi_request_handler($app);

returning_body: {
    my $cv = AE::cv;

    $cv->begin;
    my $h; $h = simple_client GET => '/', sub {
        my ($body, $headers) = @_;
        is $headers->{'Status'}, 200, "Response OK";
        is $headers->{'content-type'}, 'application/json', "... is JSON";
        ok !$headers->{'transfer-encoding'}, '... no T-E header';
        is $body, q({"message":"O hai 1"}), '... correct body';
        $cv->end;
        undef $h;
    };

    $cv->recv;
    pass "all done app 1";
}

t/51-psgi-streaming.t  view on Meta::CPAN

my $app2 = eval $APP2;
ok $app2, 'got app 2' || diag $@;
$evh->psgi_request_handler($app2);

using_writer: {
    my $cv = AE::cv;
    $cv->begin;
    my $h; $h = simple_client GET => '/', sub {
        my ($body, $headers) = @_;
        is $headers->{'Status'}, 200, "Response OK";
        is $headers->{'content-type'}, 'application/json', "... is JSON";
        is $headers->{'transfer-encoding'}, 'chunked', '... was chunked';
        is $headers->{'connection'}, 'close', '... close';
        is $body, q({"message":"O hai 2"}), "... correct de-chunked body";
        $cv->end;
        undef $h;
    };
    $cv->recv;
}

using_writer_and_1_0: {
    my $cv = AE::cv;
    $cv->begin;
    my $h2; $h2 = simple_client GET => '/', proto => '1.0', sub {
        my ($body, $headers) = @_;
        is $headers->{'Status'}, 200, "Response OK";
        is $headers->{'content-type'}, 'application/json', "... is JSON";
        ok !$headers->{'transfer-encoding'}, '... was not chunked';
        isnt $headers->{'connection'}, 'keep-alive', '... got close';
        is $body, q({"message":"O hai 3"}), "... correct body";
        $cv->end;
        undef $h2;
    };
    $cv->recv;
}

$evh->set_keepalive(1);

using_writer_and_1_1: {
    my $cv = AE::cv;
    $cv->begin;
    my $h2; $h2 = simple_client GET => '/', proto => '1.1', keepalive => 1, sub {
        my ($body, $headers) = @_;
        is $headers->{'Status'}, 200, "Response OK";
        is $headers->{'content-type'}, 'application/json', "... is JSON";
        ok $headers->{'transfer-encoding'}, '... not chunked';
        isnt $headers->{'connection'}, 'close', '... keep';
        is $body, q({"message":"O hai 4"}), "... correct de-chunked body";
        $cv->end;
        undef $h2;
    };
    $cv->recv;
}

t/52-psgi-iohandle.t  view on Meta::CPAN

ok $app, 'got an app' || diag $@;
$evh->psgi_request_handler($app);

returning_mock: {
    my $cv = AE::cv;

    $cv->begin;
    my $h; $h = simple_client GET => '/', sub {
        my ($body, $headers) = @_;
        is $headers->{'Status'}, 200, "Response OK";
        is $headers->{'content-type'}, 'text/plain';
        is $body, qq(line one\nline two\n);
        $cv->end;
        undef $h;
    };

    $cv->recv;
    pass "all done app 1";
}

my ($tempfh, $tempname) = tempfile(UNLINK=>1);

t/52-psgi-iohandle.t  view on Meta::CPAN

my $app2 = eval $APP2;
ok $app2, 'got app 2' || diag $@;
$evh->psgi_request_handler($app2);

returning_glob: {
    my $cv = AE::cv;
    $cv->begin;
    my $h; $h = simple_client GET => '/', sub {
        my ($body, $headers) = @_;
        is $headers->{'Status'}, 200, "Response OK";
        is $headers->{'content-type'}, 'text/plain';
        is $body, qq(temp line one\ntemp line two\n);
        $cv->end;
        undef $h;
    };
    $cv->recv;
}

pass "all done app 2";

my $APP3 = <<'EOAPP';

t/52-psgi-iohandle.t  view on Meta::CPAN

my $app3 = eval $APP3;
ok $app3, 'got app 3' || diag $@;
$evh->psgi_request_handler($app3);

returning_io_file: {
    my $cv = AE::cv;
    $cv->begin;
    my $h; $h = simple_client GET => '/', sub {
        my ($body, $headers) = @_;
        is $headers->{'Status'}, 200, "Response OK";
        is $headers->{'content-type'}, 'text/plain', "C-T";
        is $body, qq(temp line one\ntemp line two\n), "body";
        $cv->end;
        undef $h;
    };
    $cv->recv;
}

pass "all done app 3";

{

t/52-psgi-iohandle.t  view on Meta::CPAN

my $app4 = eval $APP4;
ok $app4, 'got app 4' || diag $@;
$evh->psgi_request_handler($app4);

returning_perlio_layer: {
    my $cv = AE::cv;
    $cv->begin;
    my $h; $h = simple_client GET => '/', sub {
        my ($body, $headers) = @_;
        is $headers->{'Status'}, 200, "Response OK";
        is $headers->{'content-type'}, 'text/plain; charset=UTF-8', "C-T";
        is decode_utf8($body), qq(\x{2603}\n), "utf8 body";
        $cv->end;
        undef $h;
    };
    $cv->recv;
}

pass "all done app 4";

my $APP5 = <<'EOAPP';

t/52-psgi-iohandle.t  view on Meta::CPAN

my $app5 = eval $APP5;
ok $app5, 'got app 5' || diag $@;
$evh->psgi_request_handler($app5);

returning_perlio_layer_from_stream: {
    my $cv = AE::cv;
    $cv->begin;
    my $h; $h = simple_client GET => '/', sub {
        my ($body, $headers) = @_;
        is $headers->{'Status'}, 200, "Response OK";
        is $headers->{'content-type'}, 'text/plain; charset=UTF-8', "C-T";
        is decode_utf8($body), qq(\x{2603}\n), "utf8 body from streamer";
        $cv->end;
        undef $h;
    };
    $cv->recv;
}

pass "all done app 5";

t/53-psgi-overloaded.t  view on Meta::CPAN

ok $app, 'got an app' || diag $@;
$evh->psgi_request_handler($app);

returning_body: {
    my $cv = AE::cv;

    $cv->begin;
    my $h; $h = simple_client GET => '/', sub {
        my ($body, $headers) = @_;
        is $headers->{'Status'}, 200, "Response OK";
        is $headers->{'content-type'}, 'application/json', "... is JSON";
        ok !$headers->{'transfer-encoding'}, '... no T-E header';
        is $body, q({"message":"O hai 1"}), '... correct body';
        $cv->end;
        undef $h;
    };

    $cv->recv;
}
pass "all done";

t/55-psgi-leak.t  view on Meta::CPAN

no_leaks_ok {
    return unless $cv;

    for my $n (1 .. CLIENTS) {
        $cv->begin;
        my $h; $h = simple_client GET => '/',
            name => "($n)",
        sub {
            my ($body, $headers) = @_;
            is $headers->{'Status'}, 200, "($n) Response OK";
            is $headers->{'content-type'}, 'text/plain', "... ($n) is text";
            is $body, 'Hello World', "... ($n) correct body";
            $cv->end;
            undef $h;
        };

    }

    $cv->recv;
    pass "done requests";
    $cv = undef;

xt/50-psgi-simple-stress.t  view on Meta::CPAN

    my $n = shift;
#     diag "($n) starting req";
    $cv->begin;
    my $r_start = AE::time;
    my $h; $h = simple_client GET => '/',
        name => "($n)",
    sub {
        my ($body, $headers) = @_;
        scope_guard { $cv->end };
#         is $headers->{'Status'}, 200, "($n) Response OK";
#         is $headers->{'content-type'}, 'text/plain', "... ($n) is text";
#         is $body, 'Hello World', "... ($n) correct body";
#         is $headers->{'content-length'}, 11;
        $total_latency += AE::time - $r_start;
        $cv->croak("extra crap!") if length($h->{rbuf});
        undef $h;
        if ($headers->{'Status'}) {
            $responses++;
            cli $n;
        }
    };