|
Packit |
a09cf7 |
#! perl -w
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
use strict;
|
|
Packit |
a09cf7 |
use warnings;
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
use Test::More;
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
plan tests => 194;
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
require HTTP::Message;
|
|
Packit |
a09cf7 |
use Config qw(%Config);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
my($m, $m2, @parts);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new;
|
|
Packit |
a09cf7 |
ok($m);
|
|
Packit |
a09cf7 |
is(ref($m), "HTTP::Message");
|
|
Packit |
a09cf7 |
is(ref($m->headers), "HTTP::Headers");
|
|
Packit |
a09cf7 |
is($m->as_string, "\n");
|
|
Packit |
a09cf7 |
is($m->headers->as_string, "");
|
|
Packit |
a09cf7 |
is($m->headers_as_string, "");
|
|
Packit |
a09cf7 |
is($m->content, "");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m->header("Foo", 1);
|
|
Packit |
a09cf7 |
is($m->as_string, "Foo: 1\n\n");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
{
|
|
Packit |
a09cf7 |
# A message with an undef set content
|
|
Packit |
a09cf7 |
# will stay consistent and have empty string
|
|
Packit |
a09cf7 |
# as a content
|
|
Packit |
a09cf7 |
my $m = HTTP::Message->new();
|
|
Packit |
a09cf7 |
$m->content(undef);
|
|
Packit |
a09cf7 |
is($m->as_string, "\n");
|
|
Packit |
a09cf7 |
is($m->content, "");
|
|
Packit |
a09cf7 |
}
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m2 = HTTP::Message->new($m->headers);
|
|
Packit |
a09cf7 |
$m2->header(bar => 2);
|
|
Packit |
a09cf7 |
is($m->as_string, "Foo: 1\n\n");
|
|
Packit |
a09cf7 |
is($m2->as_string, "Bar: 2\nFoo: 1\n\n");
|
|
Packit |
a09cf7 |
is($m2->dump, "Bar: 2\nFoo: 1\n\n(no content)\n");
|
|
Packit |
a09cf7 |
is($m2->dump(no_content => ""), "Bar: 2\nFoo: 1\n\n\n");
|
|
Packit |
a09cf7 |
is($m2->dump(no_content => "-"), "Bar: 2\nFoo: 1\n\n-\n");
|
|
Packit |
a09cf7 |
$m2->content('0');
|
|
Packit |
a09cf7 |
is($m2->dump(no_content => "-"), "Bar: 2\nFoo: 1\n\n0\n");
|
|
Packit |
a09cf7 |
is($m2->dump(no_content => "0"), "Bar: 2\nFoo: 1\n\n\\x30\n");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m2 = HTTP::Message->new($m->headers, "foo");
|
|
Packit |
a09cf7 |
is($m2->as_string, "Foo: 1\n\nfoo\n");
|
|
Packit |
a09cf7 |
is($m2->as_string("<<\n"), "Foo: 1<<\n<<\nfoo");
|
|
Packit |
a09cf7 |
$m2 = HTTP::Message->new($m->headers, "foo\n");
|
|
Packit |
a09cf7 |
is($m2->as_string, "Foo: 1\n\nfoo\n");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new([a => 1, b => 2], "abc");
|
|
Packit |
a09cf7 |
is($m->as_string, "A: 1\nB: 2\n\nabc\n");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m = HTTP::Message->parse("");
|
|
Packit |
a09cf7 |
is($m->as_string, "\n");
|
|
Packit |
a09cf7 |
$m = HTTP::Message->parse("\n");
|
|
Packit |
a09cf7 |
is($m->as_string, "\n");
|
|
Packit |
a09cf7 |
$m = HTTP::Message->parse("\n\n");
|
|
Packit |
a09cf7 |
is($m->as_string, "\n\n");
|
|
Packit |
a09cf7 |
is($m->content, "\n");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m = HTTP::Message->parse("foo");
|
|
Packit |
a09cf7 |
is($m->as_string, "\nfoo\n");
|
|
Packit |
a09cf7 |
$m = HTTP::Message->parse("foo: 1");
|
|
Packit |
a09cf7 |
is($m->as_string, "Foo: 1\n\n");
|
|
Packit |
a09cf7 |
$m = HTTP::Message->parse("foo_bar: 1");
|
|
Packit |
a09cf7 |
is($m->as_string, "Foo_bar: 1\n\n");
|
|
Packit |
a09cf7 |
$m = HTTP::Message->parse("foo: 1\n\nfoo");
|
|
Packit |
a09cf7 |
is($m->as_string, "Foo: 1\n\nfoo\n");
|
|
Packit |
a09cf7 |
$m = HTTP::Message->parse(<
|
|
Packit |
a09cf7 |
FOO : 1
|
|
Packit |
a09cf7 |
2
|
|
Packit |
a09cf7 |
3
|
|
Packit |
a09cf7 |
4
|
|
Packit |
a09cf7 |
bar:
|
|
Packit |
a09cf7 |
1
|
|
Packit |
a09cf7 |
Baz: 1
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
foobarbaz
|
|
Packit |
a09cf7 |
EOT
|
|
Packit |
a09cf7 |
is($m->as_string, <
|
|
Packit |
a09cf7 |
Bar:
|
|
Packit |
a09cf7 |
1
|
|
Packit |
a09cf7 |
Baz: 1
|
|
Packit |
a09cf7 |
FOO: 1
|
|
Packit |
a09cf7 |
2
|
|
Packit |
a09cf7 |
3
|
|
Packit |
a09cf7 |
4
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
foobarbaz
|
|
Packit |
a09cf7 |
EOT
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m = HTTP::Message->parse(<
|
|
Packit |
a09cf7 |
Date: Fri, 18 Feb 2005 18:33:46 GMT
|
|
Packit |
a09cf7 |
Connection: close
|
|
Packit |
a09cf7 |
Content-Type: text/plain
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
foo:bar
|
|
Packit |
a09cf7 |
second line
|
|
Packit |
a09cf7 |
EOT
|
|
Packit |
a09cf7 |
is($m->content(""), <
|
|
Packit |
a09cf7 |
foo:bar
|
|
Packit |
a09cf7 |
second line
|
|
Packit |
a09cf7 |
EOT
|
|
Packit |
a09cf7 |
is($m->as_string, <
|
|
Packit |
a09cf7 |
Connection: close
|
|
Packit |
a09cf7 |
Date: Fri, 18 Feb 2005 18:33:46 GMT
|
|
Packit |
a09cf7 |
Content-Type: text/plain
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
EOT
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m = HTTP::Message->parse(" abc\nfoo: 1\n");
|
|
Packit |
a09cf7 |
is($m->as_string, "\n abc\nfoo: 1\n");
|
|
Packit |
a09cf7 |
$m = HTTP::Message->parse(" foo : 1\n");
|
|
Packit |
a09cf7 |
is($m->as_string, "\n foo : 1\n");
|
|
Packit |
a09cf7 |
$m = HTTP::Message->parse("\nfoo: bar\n");
|
|
Packit |
a09cf7 |
is($m->as_string, "\nfoo: bar\n");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new([a => 1, b => 2], "abc");
|
|
Packit |
a09cf7 |
is($m->content("foo\n"), "abc");
|
|
Packit |
a09cf7 |
is($m->content, "foo\n");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m->add_content("bar");
|
|
Packit |
a09cf7 |
is($m->content, "foo\nbar");
|
|
Packit |
a09cf7 |
$m->add_content(\"\n");
|
|
Packit |
a09cf7 |
is($m->content, "foo\nbar\n");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
is(ref($m->content_ref), "SCALAR");
|
|
Packit |
a09cf7 |
is(${$m->content_ref}, "foo\nbar\n");
|
|
Packit |
a09cf7 |
${$m->content_ref} =~ s/[ao]/i/g;
|
|
Packit |
a09cf7 |
is($m->content, "fii\nbir\n");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m->clear;
|
|
Packit |
a09cf7 |
is($m->headers->header_field_names, 0);
|
|
Packit |
a09cf7 |
is($m->content, "");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
is($m->parts, undef);
|
|
Packit |
a09cf7 |
$m->parts(HTTP::Message->new,
|
|
Packit |
a09cf7 |
HTTP::Message->new([a => 1], "foo"),
|
|
Packit |
a09cf7 |
HTTP::Message->new(undef, "bar\n"),
|
|
Packit |
a09cf7 |
);
|
|
Packit |
a09cf7 |
is($m->parts->as_string, "\n");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
my $str = $m->as_string;
|
|
Packit |
a09cf7 |
$str =~ s/\r/<CR>/g;
|
|
Packit |
a09cf7 |
is($str, <
|
|
Packit |
a09cf7 |
Content-Type: multipart/mixed; boundary=xYzZY
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
--xYzZY<CR>
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
--xYzZY<CR>
|
|
Packit |
a09cf7 |
A: 1<CR>
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
foo<CR>
|
|
Packit |
a09cf7 |
--xYzZY<CR>
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
bar
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
--xYzZY--<CR>
|
|
Packit |
a09cf7 |
EOT
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m2 = HTTP::Message->new;
|
|
Packit |
a09cf7 |
$m2->parts($m);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$str = $m2->as_string;
|
|
Packit |
a09cf7 |
$str =~ s/\r/<CR>/g;
|
|
Packit |
a09cf7 |
ok($str =~ /boundary=(\S+)/);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
is($str, <
|
|
Packit |
a09cf7 |
Content-Type: multipart/mixed; boundary=$1
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
--$1<CR>
|
|
Packit |
a09cf7 |
Content-Type: multipart/mixed; boundary=xYzZY<CR>
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
--xYzZY<CR>
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
--xYzZY<CR>
|
|
Packit |
a09cf7 |
A: 1<CR>
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
foo<CR>
|
|
Packit |
a09cf7 |
--xYzZY<CR>
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
bar
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
--xYzZY--<CR>
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
--$1--<CR>
|
|
Packit |
a09cf7 |
EOT
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
@parts = $m2->parts;
|
|
Packit |
a09cf7 |
is(@parts, 1);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
@parts = $parts[0]->parts;
|
|
Packit |
a09cf7 |
is(@parts, 3);
|
|
Packit |
a09cf7 |
is($parts[1]->header("A"), 1);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m2->parts([HTTP::Message->new]);
|
|
Packit |
a09cf7 |
@parts = $m2->parts;
|
|
Packit |
a09cf7 |
is(@parts, 1);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m2->parts([]);
|
|
Packit |
a09cf7 |
@parts = $m2->parts;
|
|
Packit |
a09cf7 |
is(@parts, 0);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m->clear;
|
|
Packit |
a09cf7 |
$m2->clear;
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new([content_type => "message/http; boundary=aaa",
|
|
Packit |
a09cf7 |
],
|
|
Packit |
a09cf7 |
<
|
|
Packit |
a09cf7 |
GET / HTTP/1.1
|
|
Packit |
a09cf7 |
Host: www.example.com:8008
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
EOT
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
@parts = $m->parts;
|
|
Packit |
a09cf7 |
is(@parts, 1);
|
|
Packit |
a09cf7 |
$m2 = $parts[0];
|
|
Packit |
a09cf7 |
is(ref($m2), "HTTP::Request");
|
|
Packit |
a09cf7 |
is($m2->method, "GET");
|
|
Packit |
a09cf7 |
is($m2->uri, "/");
|
|
Packit |
a09cf7 |
is($m2->protocol, "HTTP/1.1");
|
|
Packit |
a09cf7 |
is($m2->header("Host"), "www.example.com:8008");
|
|
Packit |
a09cf7 |
is($m2->content, "");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m->content(<
|
|
Packit |
a09cf7 |
HTTP/1.0 200 OK
|
|
Packit |
a09cf7 |
Content-Type: text/plain
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
Hello
|
|
Packit |
a09cf7 |
EOT
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m2 = $m->parts;
|
|
Packit |
a09cf7 |
is(ref($m2), "HTTP::Response");
|
|
Packit |
a09cf7 |
is($m2->protocol, "HTTP/1.0");
|
|
Packit |
a09cf7 |
is($m2->code, "200");
|
|
Packit |
a09cf7 |
is($m2->message, "OK");
|
|
Packit |
a09cf7 |
is($m2->content_type, "text/plain");
|
|
Packit |
a09cf7 |
is($m2->content, "Hello\n");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
eval { $m->parts(HTTP::Message->new, HTTP::Message->new) };
|
|
Packit |
a09cf7 |
ok($@);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m->add_part(HTTP::Message->new([a=>[1..3]], "a"));
|
|
Packit |
a09cf7 |
$str = $m->as_string;
|
|
Packit |
a09cf7 |
$str =~ s/\r/<CR>/g;
|
|
Packit |
a09cf7 |
is($str, <
|
|
Packit |
a09cf7 |
Content-Type: multipart/mixed; boundary=xYzZY
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
--xYzZY<CR>
|
|
Packit |
a09cf7 |
Content-Type: message/http; boundary=aaa<CR>
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
HTTP/1.0 200 OK
|
|
Packit |
a09cf7 |
Content-Type: text/plain
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
Hello
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
--xYzZY<CR>
|
|
Packit |
a09cf7 |
A: 1<CR>
|
|
Packit |
a09cf7 |
A: 2<CR>
|
|
Packit |
a09cf7 |
A: 3<CR>
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
a<CR>
|
|
Packit |
a09cf7 |
--xYzZY--<CR>
|
|
Packit |
a09cf7 |
EOT
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m->add_part(HTTP::Message->new([b=>[1..3]], "b"));
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$str = $m->as_string;
|
|
Packit |
a09cf7 |
$str =~ s/\r/<CR>/g;
|
|
Packit |
a09cf7 |
is($str, <
|
|
Packit |
a09cf7 |
Content-Type: multipart/mixed; boundary=xYzZY
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
--xYzZY<CR>
|
|
Packit |
a09cf7 |
Content-Type: message/http; boundary=aaa<CR>
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
HTTP/1.0 200 OK
|
|
Packit |
a09cf7 |
Content-Type: text/plain
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
Hello
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
--xYzZY<CR>
|
|
Packit |
a09cf7 |
A: 1<CR>
|
|
Packit |
a09cf7 |
A: 2<CR>
|
|
Packit |
a09cf7 |
A: 3<CR>
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
a<CR>
|
|
Packit |
a09cf7 |
--xYzZY<CR>
|
|
Packit |
a09cf7 |
B: 1<CR>
|
|
Packit |
a09cf7 |
B: 2<CR>
|
|
Packit |
a09cf7 |
B: 3<CR>
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
b<CR>
|
|
Packit |
a09cf7 |
--xYzZY--<CR>
|
|
Packit |
a09cf7 |
EOT
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new;
|
|
Packit |
a09cf7 |
$m->add_part(HTTP::Message->new([a=>[1..3]], "a"));
|
|
Packit |
a09cf7 |
is($m->header("Content-Type"), "multipart/mixed; boundary=xYzZY");
|
|
Packit |
a09cf7 |
$str = $m->as_string;
|
|
Packit |
a09cf7 |
$str =~ s/\r/<CR>/g;
|
|
Packit |
a09cf7 |
is($str, <
|
|
Packit |
a09cf7 |
Content-Type: multipart/mixed; boundary=xYzZY
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
--xYzZY<CR>
|
|
Packit |
a09cf7 |
A: 1<CR>
|
|
Packit |
a09cf7 |
A: 2<CR>
|
|
Packit |
a09cf7 |
A: 3<CR>
|
|
Packit |
a09cf7 |
<CR>
|
|
Packit |
a09cf7 |
a<CR>
|
|
Packit |
a09cf7 |
--xYzZY--<CR>
|
|
Packit |
a09cf7 |
EOT
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new(['Content-Type' => 'multipart/mixed']);
|
|
Packit |
a09cf7 |
$m->add_part(HTTP::Message->new([], 'foo and a lot more content'));
|
|
Packit |
a09cf7 |
is($m->header("Content-Type"), "multipart/mixed; boundary=xYzZY");
|
|
Packit |
a09cf7 |
@parts = $m->parts;
|
|
Packit |
a09cf7 |
is($parts[0]->content, 'foo and a lot more content');
|
|
Packit |
a09cf7 |
like($parts[0]->dump(maxlength => 4), qr/foo \.\.\./);
|
|
Packit |
a09cf7 |
like($parts[0]->dump(maxlength => 0), qr/foo and a lot/);
|
|
Packit |
a09cf7 |
eval { $m->encode; };
|
|
Packit |
a09cf7 |
like($@, qr/Can't encode multipart/);
|
|
Packit |
a09cf7 |
$m->content_type('message/http');
|
|
Packit |
a09cf7 |
eval { $m->encode; };
|
|
Packit |
a09cf7 |
like($@, qr/Can't encode message/);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new;
|
|
Packit |
a09cf7 |
$m->content_ref(\my $foo);
|
|
Packit |
a09cf7 |
is($m->content_ref, \$foo);
|
|
Packit |
a09cf7 |
$foo = "foo";
|
|
Packit |
a09cf7 |
is($m->content, "foo");
|
|
Packit |
a09cf7 |
$m->add_content("bar");
|
|
Packit |
a09cf7 |
is($foo, "foobar");
|
|
Packit |
a09cf7 |
is($m->as_string, "\nfoobar\n");
|
|
Packit |
a09cf7 |
$m->content_type("message/foo");
|
|
Packit |
a09cf7 |
$m->parts(HTTP::Message->new(["h", "v"], "C"));
|
|
Packit |
a09cf7 |
is($foo, "H: v\r\n\r\nC");
|
|
Packit |
a09cf7 |
$foo =~ s/C/c/;
|
|
Packit |
a09cf7 |
$m2 = $m->parts;
|
|
Packit |
a09cf7 |
is($m2->content, "c");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new;
|
|
Packit |
a09cf7 |
$foo = [];
|
|
Packit |
a09cf7 |
$m->content($foo);
|
|
Packit |
a09cf7 |
is($m->content, $foo);
|
|
Packit |
a09cf7 |
is(${$m->content_ref}, $foo);
|
|
Packit |
a09cf7 |
is(${$m->content_ref([])}, $foo);
|
|
Packit |
a09cf7 |
isnt($m->content_ref, $foo);
|
|
Packit |
a09cf7 |
eval {$m->add_content("x")};
|
|
Packit |
a09cf7 |
like($@, qr/^Can't append to ARRAY content/);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$foo = sub { "foo" };
|
|
Packit |
a09cf7 |
$m->content($foo);
|
|
Packit |
a09cf7 |
is($m->content, $foo);
|
|
Packit |
a09cf7 |
is(${$m->content_ref}, $foo);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m->content_ref($foo);
|
|
Packit |
a09cf7 |
is($m->content, $foo);
|
|
Packit |
a09cf7 |
is($m->content_ref, $foo);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
eval {$m->content_ref("foo")};
|
|
Packit |
a09cf7 |
like($@, qr/^Setting content_ref to a non-ref/);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m->content_ref(\"foo");
|
|
Packit |
a09cf7 |
eval {$m->content("bar")};
|
|
Packit |
a09cf7 |
like($@, qr/^Modification of a read-only value/);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$foo = "foo";
|
|
Packit |
a09cf7 |
$m->content_ref(\$foo);
|
|
Packit |
a09cf7 |
is($m->content("bar"), "foo");
|
|
Packit |
a09cf7 |
is($foo, "bar");
|
|
Packit |
a09cf7 |
is($m->content, "bar");
|
|
Packit |
a09cf7 |
is($m->content_ref, \$foo);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new;
|
|
Packit |
a09cf7 |
$m->content("fo=6F");
|
|
Packit |
a09cf7 |
is($m->decoded_content, "fo=6F");
|
|
Packit |
a09cf7 |
$m->header("Content-Encoding", "quoted-printable");
|
|
Packit |
a09cf7 |
is($m->decoded_content, "foo");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
for my $encoding (qw/gzip x-gzip/) {
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new;
|
|
Packit |
a09cf7 |
$m->header("Content-Encoding", "$encoding, base64");
|
|
Packit |
a09cf7 |
$m->content_type("text/plain; charset=UTF-8");
|
|
Packit |
a09cf7 |
$m->content("H4sICFWAq0ECA3h4eAB7v3u/R6ZCSUZqUarCoxm7uAAZKHXiEAAAAA==\n");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$@ = "";
|
|
Packit |
a09cf7 |
is(eval { $m->decoded_content }, "\x{FEFF}Hi there \x{263A}\n");
|
|
Packit |
a09cf7 |
is($@ || "", "");
|
|
Packit |
a09cf7 |
is($m->content, "H4sICFWAq0ECA3h4eAB7v3u/R6ZCSUZqUarCoxm7uAAZKHXiEAAAAA==\n");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m2 = $m->clone;
|
|
Packit |
a09cf7 |
ok($m2->decode);
|
|
Packit |
a09cf7 |
is($m2->header("Content-Encoding"), undef);
|
|
Packit |
a09cf7 |
like($m2->content, qr/Hi there/);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
ok(grep { $_ eq "$encoding" } $m->decodable);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
my $tmp = MIME::Base64::decode($m->content);
|
|
Packit |
a09cf7 |
$m->content($tmp);
|
|
Packit |
a09cf7 |
$m->header("Content-Encoding", "$encoding");
|
|
Packit |
a09cf7 |
$@ = "";
|
|
Packit |
a09cf7 |
is(eval { $m->decoded_content }, "\x{FEFF}Hi there \x{263A}\n");
|
|
Packit |
a09cf7 |
is($@ || "", "");
|
|
Packit |
a09cf7 |
is($m->content, $tmp);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
my $m2 = HTTP::Message->new([
|
|
Packit |
a09cf7 |
"Content-Type" => "text/plain",
|
|
Packit |
a09cf7 |
],
|
|
Packit |
a09cf7 |
"Hi there\n"
|
|
Packit |
a09cf7 |
);
|
|
Packit |
a09cf7 |
ok($m2->encode($encoding));
|
|
Packit |
a09cf7 |
is($m2->header("Content-Encoding"), $encoding);
|
|
Packit |
a09cf7 |
unlike($m2->content, qr/Hi there/);
|
|
Packit |
a09cf7 |
is($m2->decoded_content, "Hi there\n");
|
|
Packit |
a09cf7 |
ok($m2->decode);
|
|
Packit |
a09cf7 |
is($m2->content, "Hi there\n");
|
|
Packit |
a09cf7 |
}
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m->remove_header("Content-Encoding");
|
|
Packit |
a09cf7 |
$m->content("a\xFF");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
is($m->decoded_content, "a\x{FFFD}");
|
|
Packit |
a09cf7 |
is($m->decoded_content(charset_strict => 1), undef);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m->header("Content-Encoding", "foobar");
|
|
Packit |
a09cf7 |
is($m->decoded_content, undef);
|
|
Packit |
a09cf7 |
like($@, qr/^Don't know how to decode Content-Encoding 'foobar'/);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
my $err = 0;
|
|
Packit |
a09cf7 |
eval {
|
|
Packit |
a09cf7 |
$m->decoded_content(raise_error => 1);
|
|
Packit |
a09cf7 |
$err++;
|
|
Packit |
a09cf7 |
};
|
|
Packit |
a09cf7 |
like($@, qr/Don't know how to decode Content-Encoding 'foobar'/);
|
|
Packit |
a09cf7 |
is($err, 0);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
eval {
|
|
Packit |
a09cf7 |
HTTP::Message->new([], "\x{263A}");
|
|
Packit |
a09cf7 |
};
|
|
Packit |
a09cf7 |
like($@, qr/bytes/);
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new;
|
|
Packit |
a09cf7 |
eval {
|
|
Packit |
a09cf7 |
$m->add_content("\x{263A}");
|
|
Packit |
a09cf7 |
};
|
|
Packit |
a09cf7 |
like($@, qr/bytes/);
|
|
Packit |
a09cf7 |
eval {
|
|
Packit |
a09cf7 |
$m->content("\x{263A}");
|
|
Packit |
a09cf7 |
};
|
|
Packit |
a09cf7 |
like($@, qr/bytes/);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
# test the add_content_utf8 method
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new(["Content-Type", "text/plain; charset=UTF-8"]);
|
|
Packit |
a09cf7 |
$m->add_content_utf8("\x{263A}");
|
|
Packit |
a09cf7 |
$m->add_content_utf8("-\xC5");
|
|
Packit |
a09cf7 |
is($m->content, "\xE2\x98\xBA-\xC3\x85");
|
|
Packit |
a09cf7 |
is($m->decoded_content, "\x{263A}-\x{00C5}");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new([
|
|
Packit |
a09cf7 |
"Content-Type", "text/plain",
|
|
Packit |
a09cf7 |
],
|
|
Packit |
a09cf7 |
"Hello world!"
|
|
Packit |
a09cf7 |
);
|
|
Packit |
a09cf7 |
$m->content_length(length $m->content);
|
|
Packit |
a09cf7 |
$m->encode("deflate");
|
|
Packit |
a09cf7 |
$m->dump(prefix => "# ");
|
|
Packit |
a09cf7 |
is($m->dump(prefix => "| "), <<'EOT');
|
|
Packit |
a09cf7 |
| Content-Encoding: deflate
|
|
Packit |
a09cf7 |
| Content-Type: text/plain
|
|
Packit |
a09cf7 |
|
|
|
Packit |
a09cf7 |
| x\x9C\xF3H\xCD\xC9\xC9W(\xCF/\xCAIQ\4\0\35\t\4^
|
|
Packit |
a09cf7 |
EOT
|
|
Packit |
a09cf7 |
for my $encoding (qw/identity none/) {
|
|
Packit |
a09cf7 |
my $m2 = $m->clone;
|
|
Packit |
a09cf7 |
$m2->encode("base64", $encoding);
|
|
Packit |
a09cf7 |
is($m2->as_string, <<"EOT");
|
|
Packit |
a09cf7 |
Content-Encoding: deflate, base64, $encoding
|
|
Packit |
a09cf7 |
Content-Type: text/plain
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
eJzzSM3JyVcozy/KSVEEAB0JBF4=
|
|
Packit |
a09cf7 |
EOT
|
|
Packit |
a09cf7 |
is($m2->decoded_content, "Hello world!");
|
|
Packit |
a09cf7 |
}
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
# Raw RFC 1951 deflate
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new([
|
|
Packit |
a09cf7 |
"Content-Type" => "text/plain",
|
|
Packit |
a09cf7 |
"Content-Encoding" => "deflate, base64",
|
|
Packit |
a09cf7 |
],
|
|
Packit |
a09cf7 |
"80jNyclXCM8vyklRBAA="
|
|
Packit |
a09cf7 |
);
|
|
Packit |
a09cf7 |
is($m->decoded_content, "Hello World!");
|
|
Packit |
a09cf7 |
ok(!$m->header("Client-Warning"));
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
if (eval "require IO::Uncompress::Bunzip2") {
|
|
Packit |
a09cf7 |
for my $encoding (qw/x-bzip2 bzip2/) {
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new([
|
|
Packit |
a09cf7 |
"Content-Type" => "text/plain",
|
|
Packit |
a09cf7 |
"Content-Encoding" => "$encoding, base64",
|
|
Packit |
a09cf7 |
],
|
|
Packit |
a09cf7 |
"QlpoOTFBWSZTWcvLx0QAAAHVgAAQYAAAQAYEkIAgADEAMCBoYlnQeSEMvxdyRThQkMvLx0Q=\n"
|
|
Packit |
a09cf7 |
);
|
|
Packit |
a09cf7 |
is($m->decoded_content, "Hello world!\n");
|
|
Packit |
a09cf7 |
ok($m->decode);
|
|
Packit |
a09cf7 |
is($m->content, "Hello world!\n");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
if (eval "require IO::Compress::Bzip2") {
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new([
|
|
Packit |
a09cf7 |
"Content-Type" => "text/plain",
|
|
Packit |
a09cf7 |
],
|
|
Packit |
a09cf7 |
"Hello world!"
|
|
Packit |
a09cf7 |
);
|
|
Packit |
a09cf7 |
ok($m->encode($encoding));
|
|
Packit |
a09cf7 |
is($m->header("Content-Encoding"), $encoding);
|
|
Packit |
a09cf7 |
like($m->content, qr/^BZh.*\0/);
|
|
Packit |
a09cf7 |
is($m->decoded_content, "Hello world!");
|
|
Packit |
a09cf7 |
ok($m->decode);
|
|
Packit |
a09cf7 |
is($m->content, "Hello world!");
|
|
Packit |
a09cf7 |
}
|
|
Packit |
a09cf7 |
else {
|
|
Packit |
a09cf7 |
skip("Need IO::Compress::Bzip2", undef) for 1..6;
|
|
Packit |
a09cf7 |
}
|
|
Packit |
a09cf7 |
}
|
|
Packit |
a09cf7 |
}
|
|
Packit |
a09cf7 |
else {
|
|
Packit |
a09cf7 |
skip("Need IO::Uncompress::Bunzip2", undef) for 1..18;
|
|
Packit |
a09cf7 |
}
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
# test decoding of XML content
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new(["Content-Type", "application/xml"], "\xFF\xFE<\0?\0x\0m\0l\0 \0v\0e\0r\0s\0i\0o\0n\0=\0\"\x001\0.\x000\0\"\0 \0e\0n\0c\0o\0d\0i\0n\0g\0=\0\"\0U\0T\0F\0-\x001\x006\0l\0e\0\"\0?\0>\0\n\0<\0r\0o\0o\0t\0>\0\xC9\0r\0i\0c\0<\0/\0r\0o\0o\0t\0>\0\n\0");
|
|
Packit |
a09cf7 |
is($m->decoded_content, "\n<root>\xC9ric</root>\n");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
# DESTROY is a no-op
|
|
Packit |
a09cf7 |
$m->DESTROY;
|
|
Packit |
a09cf7 |
is($m->decoded_content, "\n<root>\xC9ric</root>\n");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new([
|
|
Packit |
a09cf7 |
"Content-Type" => "text/plain",
|
|
Packit |
a09cf7 |
],
|
|
Packit |
a09cf7 |
"Hello World!\n"
|
|
Packit |
a09cf7 |
);
|
|
Packit |
a09cf7 |
is($m->content, "Hello World!\n");
|
|
Packit |
a09cf7 |
ok($m->encode());
|
|
Packit |
a09cf7 |
is($m->content, "Hello World!\n");
|
|
Packit |
a09cf7 |
is($m->encode("not-an-encoding"), 0);
|
|
Packit |
a09cf7 |
is($m->content, "Hello World!\n");
|
|
Packit |
a09cf7 |
ok($m->encode("rot13"));
|
|
Packit |
a09cf7 |
is($m->header("Content-Encoding"), "rot13");
|
|
Packit |
a09cf7 |
is($m->content, "Uryyb Jbeyq!\n");
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
for my $encoding (qw/compress x-compress/) {
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new([
|
|
Packit |
a09cf7 |
"Content-Type" => "text/plain",
|
|
Packit |
a09cf7 |
"Content-Encoding" => $encoding,
|
|
Packit |
a09cf7 |
], "foo");
|
|
Packit |
a09cf7 |
eval { $m->decoded_content(raise_error => 1); };
|
|
Packit |
a09cf7 |
like($@, qr/Can't uncompress content/);
|
|
Packit |
a09cf7 |
}
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
eval { $m = HTTP::Message->new('bad-header'); };
|
|
Packit |
a09cf7 |
like($@, qr/Bad header argument/);
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new(['Content-Encoding' => 'zog']);
|
|
Packit |
a09cf7 |
is($m->decode, 0);
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new;
|
|
Packit |
a09cf7 |
ok($m->decode);
|
|
Packit |
a09cf7 |
{
|
|
Packit |
a09cf7 |
my @warn;
|
|
Packit |
a09cf7 |
local $SIG{__WARN__} = sub { push @warn, @_ };
|
|
Packit |
a09cf7 |
local $^W = 0;
|
|
Packit |
a09cf7 |
$m->content;
|
|
Packit |
a09cf7 |
is($#warn, -1);
|
|
Packit |
a09cf7 |
local $^W = 1;
|
|
Packit |
a09cf7 |
$m->content;
|
|
Packit |
a09cf7 |
is($#warn, 0);
|
|
Packit |
a09cf7 |
like($warn[0], qr/Useless content call in void context/);
|
|
Packit |
a09cf7 |
}
|
|
Packit |
a09cf7 |
is($m->content(undef), '');
|
|
Packit |
a09cf7 |
eval { $m->content(\'foo'); };
|
|
Packit |
a09cf7 |
like($@, qr/Can't set content to be a scalar reference/);
|
|
Packit |
a09cf7 |
|
|
Packit |
a09cf7 |
$m = HTTP::Message->new (["Content-Type" => "text/plain",], "\xEF\xBB\xBFaa/");
|
|
Packit |
a09cf7 |
is($m->content_charset, "UTF-8");
|
|
Packit |
a09cf7 |
$m->content("\xFF\xFE\x00\x00aa/");
|
|
Packit |
a09cf7 |
is($m->content_charset, "UTF-32LE");
|
|
Packit |
a09cf7 |
$m->content("\x00\x00\xFE\xFFaa/");
|
|
Packit |
a09cf7 |
is($m->content_charset, "UTF-32BE");
|
|
Packit |
a09cf7 |
$m->content("\xFF\xFEaa/");
|
|
Packit |
a09cf7 |
is($m->content_charset, "UTF-16LE");
|
|
Packit |
a09cf7 |
$m->content("\xFE\xFFaa/");
|
|
Packit |
a09cf7 |
is($m->content_charset, "UTF-16BE");
|