Increase test coverage of HTTP::Config to 100% (bar POD)

More tests for HTTP::Headers and sub-modules

More tests for HTTP::Message
Aliases for encodings in Message.pm

More tests for requests, responses and status

Skip tests breaking on older perls

Avoid uninitialized warnings in Request.pm and Response.pm
Silence carp about void content call in t/message.t

carp about undef args and test them

Remove attempt to substitute on undef value in parse()

Author: openstrike

lib/HTTP/Message.pm

@@ -428,7 +428,7 @@ sub decodable
     };
     eval {
         require IO::Uncompress::Bunzip2;
-        push(@enc, "x-bzip2");
+        push(@enc, "x-bzip2", "bzip2");
     };
     # we don't care about announcing the 'identity', 'base64' and
     # 'quoted-printable' stuff
@@ -460,7 +460,7 @@ sub encode
 
     my $content = $self->content;
     for my $encoding (@enc) {
-	if ($encoding eq "identity") {
+	if ($encoding eq "identity" || $encoding eq "none") {
 	    # nothing to do
 	}
 	elsif ($encoding eq "base64") {
@@ -481,7 +481,7 @@ sub encode
 		or die "Can't deflate content: $IO::Compress::Deflate::DeflateError";
 	    $content = $output;
 	}
-	elsif ($encoding eq "x-bzip2") {
+	elsif ($encoding eq "x-bzip2" || $encoding eq "bzip2") {
 	    require IO::Compress::Bzip2;
 	    my $output;
 	    IO::Compress::Bzip2::bzip2(\$content, \$output)

lib/HTTP/Request.pm

@@ -18,8 +18,9 @@ sub new
 sub parse
 {
     my($class, $str) = @_;
+    Carp::carp('Undefined argument to parse()') if $^W && ! defined $str;
     my $request_line;
-    if ($str =~ s/^(.*)\n//) {
+    if (defined $str && $str =~ s/^(.*)\n//) {
 	$request_line = $1;
     }
     else {
@@ -28,10 +29,12 @@ sub parse
     }
 
     my $self = $class->SUPER::parse($str);
-    my($method, $uri, $protocol) = split(' ', $request_line);
-    $self->method($method) if defined($method);
-    $self->uri($uri) if defined($uri);
-    $self->protocol($protocol) if $protocol;
+    if (defined $request_line) {
+        my($method, $uri, $protocol) = split(' ', $request_line);
+        $self->method($method);
+        $self->uri($uri) if defined($uri);
+        $self->protocol($protocol) if $protocol;
+    }
     $self;
 }
 

lib/HTTP/Response.pm

@@ -21,28 +21,31 @@ sub new
 sub parse
 {
     my($class, $str) = @_;
+    Carp::carp('Undefined argument to parse()') if $^W && ! defined $str;
     my $status_line;
-    if ($str =~ s/^(.*)\n//) {
+    if (defined $str && $str =~ s/^(.*)\n//) {
 	$status_line = $1;
     }
     else {
 	$status_line = $str;
 	$str = "";
     }
 
-    $status_line =~ s/\r\z//;
+    $status_line =~ s/\r\z// if defined $status_line;
 
     my $self = $class->SUPER::parse($str);
-    my($protocol, $code, $message);
-    if ($status_line =~ /^\d{3} /) {
-       # Looks like a response created by HTTP::Response->new
-       ($code, $message) = split(' ', $status_line, 2);
-    } else {
-       ($protocol, $code, $message) = split(' ', $status_line, 3);
+    if (defined $status_line) {
+        my($protocol, $code, $message);
+        if ($status_line =~ /^\d{3} /) {
+           # Looks like a response created by HTTP::Response->new
+           ($code, $message) = split(' ', $status_line, 2);
+        } else {
+           ($protocol, $code, $message) = split(' ', $status_line, 3);
+        }
+        $self->protocol($protocol) if $protocol;
+        $self->code($code) if defined($code);
+        $self->message($message) if defined($message);
     }
-    $self->protocol($protocol) if $protocol;
-    $self->code($code) if defined($code);
-    $self->message($message) if defined($message);
     $self;
 }
 

t/common-req.t

@@ -2,7 +2,7 @@ use strict;
 use warnings;
 
 use Test::More;
-plan tests => 61;
+plan tests => 64;
 
 use HTTP::Request::Common;
 
@@ -23,6 +23,16 @@ ok($r->uri->eq("http://www.sn.no"));
 is($r->header('If-Match'), "abc");
 is($r->header("from"), "aas\@sn.no");
 
+$r = HEAD "http://www.sn.no/",
+	Content => 'foo';
+is($r->content, 'foo');
+
+$r = HEAD "http://www.sn.no/",
+	Content => 'foo',
+	'Content-Length' => 50;
+is($r->content, 'foo');
+is($r->content_length, 50);
+
 $r = PUT "http://www.sn.no",
      Content => 'foo';
 note $r->as_string, "\n";

t/headers-auth.t

@@ -3,7 +3,7 @@ use warnings;
 
 use Test::More;
 
-plan tests => 6;
+plan tests => 9;
 
 use HTTP::Response;
 use HTTP::Headers::Auth;
@@ -39,3 +39,10 @@ my $string = $res->as_string;
 like($string, qr/WWW-Authenticate: Basic realm="foo3", foo=33/);
 like($string, qr/WWW-Authenticate: Digest (nonce=bar, foo=foo|foo=foo, nonce=bar)/);
 
+$res = HTTP::Response->new(401);
+my @auth = $res->proxy_authenticate('foo');
+is_deeply(\@auth, []);
+@auth = $res->proxy_authenticate('foo', 'bar');
+is_deeply(\@auth, ['foo', {}]);
+@auth = $res->proxy_authenticate('foo', {'bar' => '_'});
+is_deeply(\@auth, ['foo', {}, 'bar', {}]);

t/headers-etag.t

@@ -3,7 +3,7 @@ use warnings;
 
 use Test::More;
 
-plan tests => 4;
+plan tests => 11;
 
 require HTTP::Headers::ETag;
 
@@ -15,6 +15,17 @@ is($h->etag, qq("tag1"));
 $h->etag("w/tag2");
 is($h->etag, qq(W/"tag2"));
 
+$h->etag(" w/, weaktag");
+is($h->etag, qq(W/"", "weaktag"));
+my @list = $h->etag;
+is_deeply(\@list, ['W/""', '"weaktag"']);
+
+$h->etag(" w/");
+is($h->etag, qq(W/""));
+
+$h->etag(" ");
+is($h->etag, "");
+
 $h->if_match(qq(W/"foo", bar, baz), "bar");
 $h->if_none_match(333);
 
@@ -27,3 +38,8 @@ is($h->if_range, $t);
 
 note $h->as_string;
 
+@list = $h->if_range;
+is($#list, 0);
+is($list[0], $t);
+$h->if_range(undef);
+is($h->if_range, '');

t/headers-util.t

@@ -28,7 +28,7 @@ my @s_tests = (
     'basic; realm="\"foo\\\\bar\""'],
 );
 
-plan tests => @s_tests + 2;
+plan tests => @s_tests + 3;
 
 for (@s_tests) {
    my($arg, $expect) = @$_;
@@ -43,3 +43,4 @@ note "# Extra tests\n";
 # some extra tests
 is(join_header_words("foo" => undef, "bar" => "baz"), "foo; bar=baz");
 is(join_header_words(), "");
+is(join_header_words([]), "");

t/headers.t

@@ -3,7 +3,7 @@ use warnings;
 
 use Test::More;
 
-plan tests => 168;
+plan tests => 188;
 
 my($h, $h2);
 sub j { join("|", @_) }
@@ -189,6 +189,7 @@ is(j($h->header_field_names), "Date|If-Modified-Since|If-Unmodified-Since|Expire
 
 $h->clear;
 is($h->content_type, "");
+is($h->content_type(""), "");
 is($h->content_type("text/html"), "");
 is($h->content_type, "text/html");
 is($h->content_type("   TEXT  / HTML   ") , "text/html");
@@ -201,6 +202,14 @@ is($h->header("content_type"), "text/html;\n charSet = \"ISO-8859-1\"; Foo=1 ");
 ok($h->content_is_html);
 ok(!$h->content_is_xhtml);
 ok(!$h->content_is_xml);
+$h->content_type("application/vnd.wap.xhtml+xml");
+ok($h->content_is_html);
+ok($h->content_is_xhtml);
+ok($h->content_is_xml);
+$h->content_type("text/xml");
+ok(!$h->content_is_html);
+ok(!$h->content_is_xhtml);
+ok($h->content_is_xml);
 $h->content_type("application/xhtml+xml");
 ok($h->content_is_html);
 ok($h->content_is_xhtml);
@@ -453,6 +462,33 @@ content_type: text/html
 foo_bar: 1
 EOT
 
+$h = HTTP::Headers->new;
+ok(!defined $h->warning('foo', 'INIT'));
+is($h->warning('bar'), 'foo');
+is($h->warning('baz', 'GET'), 'bar');
+is($h->as_string, <<EOT);
+Warning: bar
+EOT
+
+$h = HTTP::Headers->new;
+ok(!defined $h->header(':foo', 'bar'));
+ok(!defined $h->header(':zap', 'bang'));
+$h->push_header(':zap', ['kapow', 'shazam']);
+is(j($h->header_field_names), ':foo|:zap');
+is(j($h->header_field_names), ':foo|:zap');
+$h->scan(sub { $_[1] .= '!' });
+is(j($h->header(':zap')), 'bang!|kapow!|shazam!');
+is(j($h->header(':foo')), 'bar');
+is($h->as_string, <<EOT);
+foo: bar
+zap: bang!
+zap: kapow!
+zap: shazam!
+EOT
+is(j($h->remove_header(':zap')), 'bang!|kapow!|shazam!');
+$h->push_header(':zap', 'whomp', ':foo', 'quux');
+is(j($h->header(':foo')), 'bar|quux');
+
 # [RT#30579] IE6 appens "; length = NNNN" on If-Modified-Since (can we handle it)
 $h = HTTP::Headers->new(
     if_modified_since => "Sat, 29 Oct 1994 19:43:31 GMT; length=34343"

t/http-config.t

@@ -2,19 +2,34 @@ use strict;
 use warnings;
 
 use Test::More;
-plan tests => 16;
+plan tests => 28;
 
 use HTTP::Config;
 
 sub j { join("|", @_) }
 
 my $conf = HTTP::Config->new;
 ok($conf->empty);
+is($conf->entries, 0);
 $conf->add_item(42);
 ok(!$conf->empty);
+is($conf->entries, 1);
 is(j($conf->matching_items("http://www.example.com/foo")), 42);
 is(j($conf->remove_items), 42);
+is(j($conf->remove_items), '');
 is($conf->matching_items("http://www.example.com/foo"), 0);
+is($conf->matching_items('foo', 'bar', 'baz'), 0);
+$conf->add({item => "http://www.example.com/foo", m_uri__HEAD => undef});
+is($conf->entries, 1);
+is($conf->matching_items("http://www.example.com/foo"), 0);
+SKIP: {
+	my $res;
+	eval { $res = $conf->matching_items(0); };
+	skip "can fails on non-object", 2 if $@;
+	is($res, 0);
+	eval { $res = $conf->matching(0); };
+	ok(!defined $res);
+}
 
 $conf = HTTP::Config->new;
 
@@ -27,6 +42,10 @@ $conf->add_item("not secure", m_secure => 0);
 $conf->add_item("slash", m_host_port => "www.example.com:80", m_path_prefix => "/");
 $conf->add_item("u:p", m_host_port => "www.example.com:80", m_path_prefix => "/foo");
 $conf->add_item("success", m_code => "2xx");
+is($conf->find(m_domain => ".com")->{item}, '.com');
+my @found = $conf->find(m_domain => ".com");
+is($#found, 0);
+is($found[0]->{item}, '.com');
 
 use HTTP::Request;
 my $request = HTTP::Request->new(HEAD => "http://www.example.com/foo/bar");
@@ -70,6 +89,8 @@ is(j($conf->matching_items($response)), "xhtml|html|any");
 $response->content_type("text/html");
 is(j($conf->matching_items($response)), "HTML|html|text|any");
 
+$response->request(undef);
+is(j($conf->matching_items($response)), "HTML|html|text|any");
 
 {
     my @warnings;