/t/12-headers.t

 1#!/usr/bin/perl
 2
 3use strict;
 4use Perlbal::Test;
 5use Test::More 'no_plan';
 6
 7use Perlbal;
 8use Perlbal::HTTPHeaders;
 9
10# classes we will be testing
11my @classes = ('Perlbal::HTTPHeaders');
12if (eval "use Perlbal::XS::HTTPHeaders 0.20; 1;") {
13    push @classes, $Perlbal::XSModules{headers};
14}
15
16# verify they work
17foreach my $class (@classes) {
18    # basic request, just tests to see if the class is functioning
19    my $req = \ "GET / HTTP/1.0\r\n\r\n";
20    my $c_req = $class->new($req);
21    ok($c_req, "basic request - $class");
22
23    # basic response, same
24    my $resp = \ "HTTP/1.0 200 OK\r\n\r\n";
25    my $c_resp = $class->new($resp, 1);
26    ok($c_resp, "basic response - $class");
27
28    # test for a bug in the XS headers that caused headers with no content
29    # to be disconnected from the server
30    my $hdr = \ "GET / HTTP/1.0\r\nHeader: content\r\nAnother: \r\nSomething:\r\n\r\n";
31    my $obj = $class->new($hdr);
32    ok($obj, "headers without content 1 - $class");
33    is($obj->header('header'), 'content', "headers without content 2 - $class");
34    is($obj->header('anoTHER'), '', "headers without content 3 - $class");
35    is($obj->header('notthere'), undef, "headers without content 4 - $class");
36
37    is_deeply([sort map {lc} @{ $obj->headers_list }], [qw/ another header something /], 'headers_list');
38}
39
401;