/t/12-headers.t

http://github.com/perlbal/Perlbal · Perl · 40 lines · 25 code · 8 blank · 7 comment · 1 complexity · 853dec338b2150d0681decba411e7bef MD5 · raw file

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