HTTP-Message-6.06/ 000755 000765 000024 00000000000 12040620202 014040 5 ustar 00gisle staff 000000 000000 HTTP-Message-6.06/Changes 000644 000765 000024 00000004735 12040620143 015350 0 ustar 00gisle staff 000000 000000 _______________________________________________________________________________
2012-10-21 HTTP-Message 6.06
Gisle Aas (2):
More forgiving test on croak message [RT#80302]
Added test for multipart parsing
Mark Overmeer (1):
Multipart end boundary doesn't need match a complete line [RT#79239]
_______________________________________________________________________________
2012-10-20 HTTP-Message 6.05
Gisle Aas (5):
Updated ignores
No need to prevent visiting field values starting with '_'
Report the correct croak caller for delegated methods
Disallow empty field names or field names containing ':'
Make the extra std_case entries local to each header
_______________________________________________________________________________
2012-09-30 HTTP-Message 6.04
Gisle Aas (5):
Updated repository URL
Avoid undef warning for empty content
Teach $m->content_charset about JSON
Use the canonical charset name for UTF-16LE (and frieds)
Add option to override the "(no content)" marker of $m->dump
Christopher J. Madsen (2):
Use IO::HTML for encoding sniffing
mime_name was introduced in Encode 2.21
Tom Hukins (1):
Remove an unneeded "require"
Ville Skyttä (1):
Spelling fixes.
chromatic (1):
Sanitized PERL_HTTP_URI_CLASS environment variable.
Martin H. Sluka (1):
Add test from RT#77466
Father Chrysostomos (1):
Fix doc grammo [RT#75831]
_______________________________________________________________________________
2012-02-16 HTTP-Message 6.03
Support 'bzip2' as alternative to Content-Encoding: x-bzip2. Some
servers seem to return it.
Make newlines in forms be "\r\n" terminated.
Added some more status codes.
Restore perl-5.8.1 compatibility.
_______________________________________________________________________________
2011-03-20 HTTP-Message 6.02
Declare dependency on Bunzip2 v2.021 [RT#66593]
_______________________________________________________________________________
2011-03-07 HTTP-Message 6.01
Avoid loading XML::Simple to avoid test failures.
Eliminate the HTML::Entities dependency.
_______________________________________________________________________________
2011-02-27 HTTP-Message 6.00
Initial release of HTTP-Message as a separate distribution. There are no code
changes besides incrementing the version number since libwww-perl-5.837.
The HTTP::Message module with friends used to be bundled with the libwww-perl
distribution.
HTTP-Message-6.06/lib/ 000755 000765 000024 00000000000 12040620202 014606 5 ustar 00gisle staff 000000 000000 HTTP-Message-6.06/Makefile.PL 000644 000765 000024 00000003215 11760411040 016021 0 ustar 00gisle staff 000000 000000 #!perl -w
require 5.008001;
use strict;
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'HTTP::Message',
VERSION_FROM => 'lib/HTTP/Message.pm',
ABSTRACT => 'HTTP style messages',
AUTHOR => 'Gisle Aas ',
LICENSE => "perl",
MIN_PERL_VERSION => 5.008001,
PREREQ_PM => {
'URI' => "1.10",
'HTTP::Date' => 6,
'MIME::Base64' => "2.1",
'MIME::QuotedPrint' => 0,
'IO::HTML' => 0,
'Encode' => "2.21", # need mime_name
'Encode::Locale' => 1,
'LWP::MediaTypes' => 6,
'Compress::Raw::Zlib' => 0,
'IO::Compress::Gzip' => 0,
'IO::Compress::Deflate' => 0,
'IO::Compress::Bzip2' => '2.021',
'IO::Uncompress::Gunzip' => 0,
'IO::Uncompress::Inflate' => 0,
'IO::Uncompress::RawInflate' => 0,
'IO::Uncompress::Bunzip2' => '2.021',
},
META_MERGE => {
resources => {
repository => 'http://github.com/libwww-perl/http-message',
MailingList => 'mailto:libwww@perl.org',
}
},
);
BEGIN {
# compatibility with older versions of MakeMaker
my $developer = -f ".gitignore";
my %mm_req = (
LICENCE => 6.31,
META_MERGE => 6.45,
META_ADD => 6.45,
MIN_PERL_VERSION => 6.48,
);
undef(*WriteMakefile);
*WriteMakefile = sub {
my %arg = @_;
for (keys %mm_req) {
unless (eval { ExtUtils::MakeMaker->VERSION($mm_req{$_}) }) {
warn "$_ $@" if $developer;
delete $arg{$_};
}
}
ExtUtils::MakeMaker::WriteMakefile(%arg);
};
}
HTTP-Message-6.06/MANIFEST 000644 000765 000024 00000001117 12040620202 015171 0 ustar 00gisle staff 000000 000000 Changes
lib/HTTP/Config.pm
lib/HTTP/Headers.pm
lib/HTTP/Headers/Auth.pm
lib/HTTP/Headers/ETag.pm
lib/HTTP/Headers/Util.pm
lib/HTTP/Message.pm
lib/HTTP/Request.pm
lib/HTTP/Request/Common.pm
lib/HTTP/Response.pm
lib/HTTP/Status.pm
Makefile.PL
MANIFEST This list of files
README
t/common-req.t
t/headers-auth.t
t/headers-etag.t
t/headers-util.t
t/headers.t
t/http-config.t
t/message-charset.t
t/message-decode-xml.t
t/message-old.t
t/message-parts.t
t/message.t
t/request.t
t/response.t
t/status-old.t
t/status.t
META.yml Module meta-data (added by MakeMaker)
HTTP-Message-6.06/META.yml 000644 000765 000024 00000002200 12040620202 015303 0 ustar 00gisle staff 000000 000000 --- #YAML:1.0
name: HTTP-Message
version: 6.06
abstract: HTTP style messages
author:
- Gisle Aas
license: perl
distribution_type: module
configure_requires:
ExtUtils::MakeMaker: 0
build_requires:
ExtUtils::MakeMaker: 0
requires:
Compress::Raw::Zlib: 0
Encode: 2.21
Encode::Locale: 1
HTTP::Date: 6
IO::Compress::Bzip2: 2.021
IO::Compress::Deflate: 0
IO::Compress::Gzip: 0
IO::HTML: 0
IO::Uncompress::Bunzip2: 2.021
IO::Uncompress::Gunzip: 0
IO::Uncompress::Inflate: 0
IO::Uncompress::RawInflate: 0
LWP::MediaTypes: 6
MIME::Base64: 2.1
MIME::QuotedPrint: 0
perl: 5.008001
URI: 1.10
resources:
MailingList: mailto:libwww@perl.org
repository: http://github.com/libwww-perl/http-message
no_index:
directory:
- t
- inc
generated_by: ExtUtils::MakeMaker version 6.57_05
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
HTTP-Message-6.06/README 000644 000765 000024 00000001737 11717003531 014742 0 ustar 00gisle staff 000000 000000 The HTTP-Message distribution contains classes useful for representing the
messages passed in HTTP style communication. These are classes representing
requests, responses and the headers contained within them.
The following classes are provided:
HTTP::Message base class (what's common between requests and responses)
- HTTP::Request request on a resource (subclass of message)
- HTTP::Response response from the resource (subclass of message)
HTTP::Headers headers embedded in messages
Other related modules:
HTTP::Config configuration of request/response handling
HTTP::Headers::Util helper functions for parsing of HTTP header values
HTTP::Request::Common helper functions for constructing requests
HTTP::Status symbolic names for the HTTP response status codes
This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
Copyright 1995-2008 Gisle Aas.
HTTP-Message-6.06/t/ 000755 000765 000024 00000000000 12040620202 014303 5 ustar 00gisle staff 000000 000000 HTTP-Message-6.06/t/common-req.t 000644 000765 000024 00000013633 11760403103 016562 0 ustar 00gisle staff 000000 000000 #perl -w
use Test;
plan tests => 57;
use HTTP::Request::Common;
$r = GET 'http://www.sn.no/';
print $r->as_string;
ok($r->method, "GET");
ok($r->uri, "http://www.sn.no/");
$r = HEAD "http://www.sn.no/",
If_Match => 'abc',
From => 'aas@sn.no';
print $r->as_string;
ok($r->method, "HEAD");
ok($r->uri->eq("http://www.sn.no"));
ok($r->header('If-Match'), "abc");
ok($r->header("from"), "aas\@sn.no");
$r = PUT "http://www.sn.no",
Content => 'foo';
print $r->as_string, "\n";
ok($r->method, "PUT");
ok($r->uri->host, "www.sn.no");
ok(!defined($r->header("Content")));
ok(${$r->content_ref}, "foo");
ok($r->content, "foo");
ok($r->content_length, 3);
#--- Test POST requests ---
$r = POST "http://www.sn.no", [foo => 'bar;baz',
baz => [qw(a b c)],
foo => 'zoo=&',
"space " => " + ",
"nl" => "a\nb\r\nc\n",
],
bar => 'foo';
print $r->as_string, "\n";
ok($r->method, "POST");
ok($r->content_type, "application/x-www-form-urlencoded");
ok($r->content_length, 83);
ok($r->header("bar"), "foo");
ok($r->content, "foo=bar%3Bbaz&baz=a&baz=b&baz=c&foo=zoo%3D%26&space+=+%2B+&nl=a%0D%0Ab%0D%0Ac%0D%0A");
$r = POST "http://example.com";
ok($r->content_length, 0);
ok($r->content, "");
$r = POST "http://example.com", [];
ok($r->content_length, 0);
ok($r->content, "");
$r = POST "mailto:gisle\@aas.no",
Subject => "Heisan",
Content_Type => "text/plain",
Content => "Howdy\n";
#print $r->as_string;
ok($r->method, "POST");
ok($r->header("Subject"), "Heisan");
ok($r->content, "Howdy\n");
ok($r->content_type, "text/plain");
{
my @warnings;
local $SIG{__WARN__} = sub { push @warnings, @_ };
$r = POST 'http://unf.ug/', [];
ok( "@warnings", '', 'empty POST' );
}
#
# POST for File upload
#
$file = "test-$$";
open(FILE, ">$file") or die "Can't create $file: $!";
print FILE "foo\nbar\nbaz\n";
close(FILE);
$r = POST 'http://www.perl.org/survey.cgi',
Content_Type => 'form-data',
Content => [ name => 'Gisle Aas',
email => 'gisle@aas.no',
gender => 'm',
born => '1964',
file => [$file],
];
#print $r->as_string;
unlink($file) or warn "Can't unlink $file: $!";
ok($r->method, "POST");
ok($r->uri->path, "/survey.cgi");
ok($r->content_type, "multipart/form-data");
ok($r->header(Content_type) =~ /boundary="?([^"]+)"?/);
$boundary = $1;
$c = $r->content;
$c =~ s/\r//g;
@c = split(/--\Q$boundary/, $c);
print "$c[5]\n";
ok(@c == 7 and $c[6] =~ /^--\n/); # 5 parts + header & trailer
ok($c[2] =~ /^Content-Disposition:\s*form-data;\s*name="email"/m);
ok($c[2] =~ /^gisle\@aas.no$/m);
ok($c[5] =~ /^Content-Disposition:\s*form-data;\s*name="file";\s*filename="$file"/m);
ok($c[5] =~ /^Content-Type:\s*text\/plain$/m);
ok($c[5] =~ /^foo\nbar\nbaz/m);
$r = POST 'http://www.perl.org/survey.cgi',
[ file => [ undef, "xxy\"", Content_type => "text/html", Content => "Hello, world!
" ]],
Content_type => 'multipart/form-data';
print $r->as_string;
ok($r->content =~ /^--\S+\015\012Content-Disposition:\s*form-data;\s*name="file";\s*filename="xxy\\"/m);
ok($r->content =~ /^Content-Type: text\/html/m);
ok($r->content =~ /^Hello, world/m);
$r = POST 'http://www.perl.org/survey.cgi',
Content_type => 'multipart/form-data',
Content => [ file => [ undef, undef, Content => "foo"]];
#print $r->as_string;
ok($r->content !~ /filename=/);
# The POST routine can now also take a hash reference.
my %hash = (foo => 42, bar => 24);
$r = POST 'http://www.perl.org/survey.cgi', \%hash;
#print $r->as_string, "\n";
ok($r->content =~ /foo=42/);
ok($r->content =~ /bar=24/);
ok($r->content_type, "application/x-www-form-urlencoded");
ok($r->content_length, 13);
#
# POST for File upload
#
use HTTP::Request::Common qw($DYNAMIC_FILE_UPLOAD);
$file = "test-$$";
open(FILE, ">$file") or die "Can't create $file: $!";
for (1..1000) {
print FILE "a" .. "z";
}
close(FILE);
$DYNAMIC_FILE_UPLOAD++;
$r = POST 'http://www.perl.org/survey.cgi',
Content_Type => 'form-data',
Content => [ name => 'Gisle Aas',
email => 'gisle@aas.no',
gender => 'm',
born => '1964',
file => [$file],
];
print $r->as_string, "\n";
ok($r->method, "POST");
ok($r->uri->path, "/survey.cgi");
ok($r->content_type, "multipart/form-data");
ok($r->header(Content_type) =~ /boundary="?([^"]+)"?/);
$boundary = $1;
ok(ref($r->content), "CODE");
ok(length($boundary) > 10);
$code = $r->content;
my $chunk;
my @chunks;
while (defined($chunk = &$code) && length $chunk) {
push(@chunks, $chunk);
}
unlink($file) or warn "Can't unlink $file: $!";
$_ = join("", @chunks);
print int(@chunks), " chunks, total size is ", length($_), " bytes\n";
# should be close to expected size and number of chunks
ok(abs(@chunks - 15 < 3));
ok(abs(length($_) - 26589) < 20);
$r = POST 'http://www.example.com';
ok($r->as_string, < 'form-data', Content => [];
ok($r->as_string, < 'form-data';
#print $r->as_string;
ok($r->as_string, <method, "DELETE");
$r = HTTP::Request::Common::PUT 'http://www.example.com',
'Content-Type' => 'application/octet-steam',
'Content' => 'foobarbaz',
'Content-Length' => 12; # a slight lie
ok($r->header('Content-Length'), 12);
HTTP-Message-6.06/t/headers-auth.t 000644 000765 000024 00000002105 11717003531 017052 0 ustar 00gisle staff 000000 000000 #!perl -w
use strict;
use Test;
plan tests => 6;
use HTTP::Response;
use HTTP::Headers::Auth;
my $res = HTTP::Response->new(401);
$res->push_header(WWW_Authenticate => qq(Foo realm="WallyWorld", foo=bar, Bar realm="WallyWorld2"));
$res->push_header(WWW_Authenticate => qq(Basic Realm="WallyWorld", foo=bar, bar=baz));
print $res->as_string;
my %auth = $res->www_authenticate;
ok(keys(%auth), 3);
ok($auth{basic}{realm}, "WallyWorld");
ok($auth{bar}{realm}, "WallyWorld2");
$a = $res->www_authenticate;
ok($a, 'Foo realm="WallyWorld", foo=bar, Bar realm="WallyWorld2", Basic Realm="WallyWorld", foo=bar, bar=baz');
$res->www_authenticate("Basic realm=foo1");
print $res->as_string;
$res->www_authenticate(Basic => {realm => "foo2"});
print $res->as_string;
$res->www_authenticate(Basic => [realm => "foo3", foo=>33],
Digest => {nonce=>"bar", foo=>'foo'});
print $res->as_string;
$_ = $res->as_string;
ok(/WWW-Authenticate: Basic realm="foo3", foo=33/);
ok(/WWW-Authenticate: Digest nonce=bar, foo=foo/ ||
/WWW-Authenticate: Digest foo=foo, nonce=bar/);
HTTP-Message-6.06/t/headers-etag.t 000644 000765 000024 00000000624 11717003531 017035 0 ustar 00gisle staff 000000 000000 #!perl -w
use strict;
use Test;
plan tests => 4;
require HTTP::Headers::ETag;
my $h = HTTP::Headers->new;
$h->etag("tag1");
ok($h->etag, qq("tag1"));
$h->etag("w/tag2");
ok($h->etag, qq(W/"tag2"));
$h->if_match(qq(W/"foo", bar, baz), "bar");
$h->if_none_match(333);
$h->if_range("tag3");
ok($h->if_range, qq("tag3"));
my $t = time;
$h->if_range($t);
ok($h->if_range, $t);
print $h->as_string;
HTTP-Message-6.06/t/headers-util.t 000644 000765 000024 00000002267 11717003531 017077 0 ustar 00gisle staff 000000 000000 #!perl -w
use strict;
use Test;
use HTTP::Headers::Util qw(split_header_words join_header_words);
my @s_tests = (
["foo" => "foo"],
["foo=bar" => "foo=bar"],
[" foo " => "foo"],
["foo=" => 'foo=""'],
["foo=bar bar=baz" => "foo=bar; bar=baz"],
["foo=bar;bar=baz" => "foo=bar; bar=baz"],
['foo bar baz' => "foo; bar; baz"],
['foo="\"" bar="\\\\"' => 'foo="\""; bar="\\\\"'],
['foo,,,bar' => 'foo, bar'],
['foo=bar,bar=baz' => 'foo=bar, bar=baz'],
['TEXT/HTML; CHARSET=ISO-8859-1' =>
'text/html; charset=ISO-8859-1'],
['foo="bar"; port="80,81"; discard, bar=baz' =>
'foo=bar; port="80,81"; discard, bar=baz'],
['Basic realm="\"foo\\\\bar\""' =>
'basic; realm="\"foo\\\\bar\""'],
);
plan tests => @s_tests + 2;
for (@s_tests) {
my($arg, $expect) = @$_;
my @arg = ref($arg) ? @$arg : $arg;
my $res = join_header_words(split_header_words(@arg));
ok($res, $expect);
}
print "# Extra tests\n";
# some extra tests
ok(join_header_words("foo" => undef, "bar" => "baz"), "foo; bar=baz");
ok(join_header_words(), "");
HTTP-Message-6.06/t/headers.t 000644 000765 000024 00000026573 12040613413 016126 0 ustar 00gisle staff 000000 000000 #!perl -w
use strict;
use Test qw(plan ok);
plan tests => 166;
my($h, $h2);
sub j { join("|", @_) }
require HTTP::Headers;
$h = HTTP::Headers->new;
ok($h);
ok(ref($h), "HTTP::Headers");
ok($h->as_string, "");
$h = HTTP::Headers->new(foo => "bar", foo => "baaaaz", Foo => "baz");
ok($h->as_string, "Foo: bar\nFoo: baaaaz\nFoo: baz\n");
$h = HTTP::Headers->new(foo => ["bar", "baz"]);
ok($h->as_string, "Foo: bar\nFoo: baz\n");
$h = HTTP::Headers->new(foo => 1, bar => 2, foo_bar => 3);
ok($h->as_string, "Bar: 2\nFoo: 1\nFoo-Bar: 3\n");
ok($h->as_string(";"), "Bar: 2;Foo: 1;Foo-Bar: 3;");
ok($h->header("Foo"), 1);
ok($h->header("FOO"), 1);
ok(j($h->header("foo")), 1);
ok($h->header("foo-bar"), 3);
ok($h->header("foo_bar"), 3);
ok($h->header("Not-There"), undef);
ok(j($h->header("Not-There")), "");
ok(eval { $h->header }, undef);
ok($@);
ok($h->header("Foo", 11), 1);
ok($h->header("Foo", [1, 1]), 11);
ok($h->header("Foo"), "1, 1");
ok(j($h->header("Foo")), "1|1");
ok($h->header(foo => 11, Foo => 12, bar => 22), 2);
ok($h->header("Foo"), "11, 12");
ok($h->header("Bar"), 22);
ok($h->header("Bar", undef), 22);
ok(j($h->header("bar", 22)), "");
$h->push_header(Bar => 22);
ok($h->header("Bar"), "22, 22");
$h->push_header(Bar => [23 .. 25]);
ok($h->header("Bar"), "22, 22, 23, 24, 25");
ok(j($h->header("Bar")), "22|22|23|24|25");
$h->clear;
$h->header(Foo => 1);
ok($h->as_string, "Foo: 1\n");
$h->init_header(Foo => 2);
$h->init_header(Bar => 2);
ok($h->as_string, "Bar: 2\nFoo: 1\n");
$h->init_header(Foo => [2, 3]);
$h->init_header(Baz => [2, 3]);
ok($h->as_string, "Bar: 2\nBaz: 2\nBaz: 3\nFoo: 1\n");
eval { $h->init_header(A => 1, B => 2, C => 3) };
ok($@);
ok($h->as_string, "Bar: 2\nBaz: 2\nBaz: 3\nFoo: 1\n");
ok($h->clone->remove_header("Foo"), 1);
ok($h->clone->remove_header("Bar"), 1);
ok($h->clone->remove_header("Baz"), 2);
ok($h->clone->remove_header(qw(Foo Bar Baz Not-There)), 4);
ok($h->clone->remove_header("Not-There"), 0);
ok(j($h->clone->remove_header("Foo")), 1);
ok(j($h->clone->remove_header("Bar")), 2);
ok(j($h->clone->remove_header("Baz")), "2|3");
ok(j($h->clone->remove_header(qw(Foo Bar Baz Not-There))), "1|2|2|3");
ok(j($h->clone->remove_header("Not-There")), "");
$h = HTTP::Headers->new(
allow => "GET",
content => "none",
content_type => "text/html",
content_md5 => "dummy",
content_encoding => "gzip",
content_foo => "bar",
last_modified => "yesterday",
expires => "tomorrow",
etag => "abc",
date => "today",
user_agent => "libwww-perl",
zoo => "foo",
);
ok($h->as_string, <clone;
ok($h->as_string, $h2->as_string);
ok($h->remove_content_headers->as_string, <as_string, <remove_content_headers;
ok($h->as_string, $h2->as_string);
$h->clear;
ok($h->as_string, "");
undef($h2);
$h = HTTP::Headers->new;
ok($h->header_field_names, 0);
ok(j($h->header_field_names), "");
$h = HTTP::Headers->new( etag => 1, foo => [2,3],
content_type => "text/plain");
ok($h->header_field_names, 3);
ok(j($h->header_field_names), "ETag|Content-Type|Foo");
{
my @tmp;
$h->scan(sub { push(@tmp, @_) });
ok(j(@tmp), "ETag|1|Content-Type|text/plain|Foo|2|Foo|3");
@tmp = ();
eval { $h->scan(sub { push(@tmp, @_); die if $_[0] eq "Content-Type" }) };
ok($@);
ok(j(@tmp), "ETag|1|Content-Type|text/plain");
@tmp = ();
$h->scan(sub { push(@tmp, @_) });
ok(j(@tmp), "ETag|1|Content-Type|text/plain|Foo|2|Foo|3");
}
# CONVENIENCE METHODS
$h = HTTP::Headers->new;
ok($h->date, undef);
ok($h->date(time), undef);
ok(j($h->header_field_names), "Date");
ok($h->header("Date") =~ /^[A-Z][a-z][a-z], \d\d .* GMT$/);
{
my $off = time - $h->date;
ok($off == 0 || $off == 1);
}
if ($] < 5.006) {
Test::skip("Can't call variable method", 1) for 1..13;
}
else {
# other date fields
for my $field (qw(expires if_modified_since if_unmodified_since
last_modified))
{
eval <<'EOT'; die $@ if $@;
ok($h->$field, undef);
ok($h->$field(time), undef);
ok((time - $h->$field) =~ /^[01]$/);
EOT
}
ok(j($h->header_field_names), "Date|If-Modified-Since|If-Unmodified-Since|Expires|Last-Modified");
}
$h->clear;
ok($h->content_type, "");
ok($h->content_type("text/html"), "");
ok($h->content_type, "text/html");
ok($h->content_type(" TEXT / HTML ") , "text/html");
ok($h->content_type, "text/html");
ok(j($h->content_type), "text/html");
ok($h->content_type("text/html;\n charSet = \"ISO-8859-1\"; Foo=1 "), "text/html");
ok($h->content_type, "text/html");
ok(j($h->content_type), "text/html|charSet = \"ISO-8859-1\"; Foo=1 ");
ok($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/xhtml+xml");
ok($h->content_is_html);
ok($h->content_is_xhtml);
ok($h->content_is_xml);
ok($h->content_type("text/html;\n charSet = \"ISO-8859-1\"; Foo=1 "), "application/xhtml+xml");
ok($h->content_encoding, undef);
ok($h->content_encoding("gzip"), undef);
ok($h->content_encoding, "gzip");
ok(j($h->header_field_names), "Content-Encoding|Content-Type");
ok($h->content_language, undef);
ok($h->content_language("no"), undef);
ok($h->content_language, "no");
ok($h->title, undef);
ok($h->title("This is a test"), undef);
ok($h->title, "This is a test");
ok($h->user_agent, undef);
ok($h->user_agent("Mozilla/1.2"), undef);
ok($h->user_agent, "Mozilla/1.2");
ok($h->server, undef);
ok($h->server("Apache/2.1"), undef);
ok($h->server, "Apache/2.1");
ok($h->from("Gisle\@ActiveState.com"), undef);
ok($h->header("from", "Gisle\@ActiveState.com"));
ok($h->referer("http://www.example.com"), undef);
ok($h->referer, "http://www.example.com");
ok($h->referrer, "http://www.example.com");
ok($h->referer("http://www.example.com/#bar"), "http://www.example.com");
ok($h->referer, "http://www.example.com/");
{
require URI;
my $u = URI->new("http://www.example.com#bar");
$h->referer($u);
ok($u->as_string, "http://www.example.com#bar");
ok($h->referer->fragment, undef);
ok($h->referrer->as_string, "http://www.example.com");
}
ok($h->as_string, <clear;
ok($h->www_authenticate("foo"), undef);
ok($h->www_authenticate("bar"), "foo");
ok($h->www_authenticate, "bar");
ok($h->proxy_authenticate("foo"), undef);
ok($h->proxy_authenticate("bar"), "foo");
ok($h->proxy_authenticate, "bar");
ok($h->authorization_basic, undef);
ok($h->authorization_basic("u"), undef);
ok($h->authorization_basic("u", "p"), "u:");
ok($h->authorization_basic, "u:p");
ok(j($h->authorization_basic), "u|p");
ok($h->authorization, "Basic dTpw");
ok(eval { $h->authorization_basic("u2:p") }, undef);
ok($@);
ok(j($h->authorization_basic), "u|p");
ok($h->proxy_authorization_basic("u2", "p2"), undef);
ok(j($h->proxy_authorization_basic), "u2|p2");
ok($h->proxy_authorization, "Basic dTI6cDI=");
ok($h->as_string, <new;
eval {
$line = __LINE__; $h->header('foo:', 1);
};
ok($@, qr/^Illegal field name 'foo:' at \Q$file\E line $line/);
eval {
$line = __LINE__; $h->header('', 2);
};
ok($@, qr/^Illegal field name '' at \Q$file\E line $line/);
#---- old tests below -----
$h = new HTTP::Headers
mime_version => "1.0",
content_type => "text/html";
$h->header(URI => "http://www.oslonett.no/");
ok($h->header("MIME-Version"), "1.0");
ok($h->header('Uri'), "http://www.oslonett.no/");
$h->header("MY-header" => "foo",
"Date" => "somedate",
"Accept" => ["text/plain", "image/*"],
);
$h->push_header("accept" => "audio/basic");
ok($h->header("date"), "somedate");
my @accept = $h->header("accept");
ok(@accept, 3);
$h->remove_header("uri", "date");
my $str = $h->as_string;
my $lines = ($str =~ tr/\n/\n/);
ok($lines, 6);
$h2 = $h->clone;
$h->header("accept", "*/*");
$h->remove_header("my-header");
@accept = $h2->header("accept");
ok(@accept, 3);
@accept = $h->header("accept");
ok(@accept, 1);
# Check order of headers, but first remove this one
$h2->remove_header('mime_version');
# and add this general header
$h2->header(Connection => 'close');
my @x = ();
$h2->scan(sub {push(@x, shift);});
ok(join(";", @x), "Connection;Accept;Accept;Accept;Content-Type;MY-Header");
# Check headers with embedded newlines:
$h = HTTP::Headers->new(
a => "foo\n\n",
b => "foo\nbar",
c => "foo\n\nbar\n\n",
d => "foo\n\tbar",
e => "foo\n bar ",
f => "foo\n bar\n baz\nbaz",
);
ok($h->as_string("<<\n"), <new(
a => "foo\r\n\r\nevil body" ,
b => "foo\015\012\015\012evil body" ,
c => "foo\x0d\x0a\x0d\x0aevil body" ,
);
ok (
$h->as_string(),
"A: foo\r\n evil body\n".
"B: foo\015\012 evil body\n" .
"C: foo\x0d\x0a evil body\n" ,
"embedded CRLF are stripped out");
# Check with FALSE $HTML::Headers::TRANSLATE_UNDERSCORE
{
local($HTTP::Headers::TRANSLATE_UNDERSCORE);
$HTTP::Headers::TRANSLATE_UNDERSCORE = undef; # avoid -w warning
$h = HTTP::Headers->new;
$h->header(abc_abc => "foo");
$h->header("abc-abc" => "bar");
ok($h->header("ABC_ABC"), "foo");
ok($h->header("ABC-ABC"),"bar");
ok($h->remove_header("Abc_Abc"));
ok(!defined($h->header("abc_abc")));
ok($h->header("ABC-ABC"), "bar");
}
# Check if objects as header values works
require URI;
$h->header(URI => URI->new("http://www.perl.org"));
ok($h->header("URI")->scheme, "http");
$h->clear;
ok($h->as_string, "");
$h->content_type("text/plain");
$h->header(content_md5 => "dummy");
$h->header("Content-Foo" => "foo");
$h->header(Location => "http:", xyzzy => "plugh!");
ok($h->as_string, <remove_content_headers;
ok($h->as_string, <as_string, <new;
$h->content_type("text/plain");
$h->header(":foo_bar", 1);
$h->push_header(":content_type", "text/html");
ok(j($h->header_field_names), "Content-Type|:content_type|:foo_bar");
ok($h->header('Content-Type'), "text/plain");
ok($h->header(':Content_Type'), undef);
ok($h->header(':content_type'), "text/html");
ok($h->as_string, <new(
if_modified_since => "Sat, 29 Oct 1994 19:43:31 GMT; length=34343"
);
ok(gmtime($h->if_modified_since), "Sat Oct 29 19:43:31 1994");
HTTP-Message-6.06/t/http-config.t 000644 000765 000024 00000004340 11717003531 016725 0 ustar 00gisle staff 000000 000000 #!perl -w
use strict;
use Test;
plan tests => 14;
use HTTP::Config;
sub j { join("|", @_) }
my $conf = HTTP::Config->new;
ok($conf->empty);
$conf->add_item(42);
ok(!$conf->empty);
ok(j($conf->matching_items("http://www.example.com/foo")), 42);
ok(j($conf->remove_items), 42);
ok($conf->matching_items("http://www.example.com/foo"), 0);
$conf = HTTP::Config->new;
$conf->add_item("always");
$conf->add_item("GET", m_method => ["GET", "HEAD"]);
$conf->add_item("POST", m_method => "POST");
$conf->add_item(".com", m_domain => ".com");
$conf->add_item("secure", m_secure => 1);
$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");
use HTTP::Request;
my $request = HTTP::Request->new(HEAD => "http://www.example.com/foo/bar");
$request->header("User-Agent" => "Moz/1.0");
ok(j($conf->matching_items($request)), "u:p|slash|.com|GET|not secure|always");
$request->method("HEAD");
$request->uri->scheme("https");
ok(j($conf->matching_items($request)), ".com|GET|secure|always");
ok(j($conf->matching_items("http://activestate.com")), ".com|not secure|always");
use HTTP::Response;
my $response = HTTP::Response->new(200 => "OK");
$response->content_type("text/plain");
$response->content("Hello, world!\n");
$response->request($request);
ok(j($conf->matching_items($response)), ".com|success|GET|secure|always");
$conf->remove_items(m_secure => 1);
$conf->remove_items(m_domain => ".com");
ok(j($conf->matching_items($response)), "success|GET|always");
$conf->remove_items; # start fresh
ok(j($conf->matching_items($response)), "");
$conf->add_item("any", "m_media_type" => "*/*");
$conf->add_item("text", m_media_type => "text/*");
$conf->add_item("html", m_media_type => "html");
$conf->add_item("HTML", m_media_type => "text/html");
$conf->add_item("xhtml", m_media_type => "xhtml");
ok(j($conf->matching_items($response)), "text|any");
$response->content_type("application/xhtml+xml");
ok(j($conf->matching_items($response)), "xhtml|html|any");
$response->content_type("text/html");
ok(j($conf->matching_items($response)), "HTML|html|text|any");
HTTP-Message-6.06/t/message-charset.t 000644 000765 000024 00000006142 11744451204 017564 0 ustar 00gisle staff 000000 000000 #!perl -w
use strict;
use Test;
plan tests => 43;
use HTTP::Response;
my $r = HTTP::Response->new(200, "OK");
ok($r->content_charset, undef);
ok($r->content_type_charset, undef);
$r->content_type("text/plain");
ok($r->content_charset, undef);
$r->content("abc");
ok($r->content_charset, "US-ASCII");
$r->content("f\xE5rep\xF8lse\n");
ok($r->content_charset, "ISO-8859-1");
$r->content("f\xC3\xA5rep\xC3\xB8lse\n");
ok($r->content_charset, "UTF-8");
$r->content_type("text/html");
$r->content(<<'EOT');
EOT
ok($r->content_charset, "UTF-8");
$r->content(<<'EOT');
EOT
ok($r->content_charset, "UTF-8");
$r->content(<<'EOT');