#!/usr/bin/perl
BEGIN
{
our
$DEBUG
=
exists
(
$ENV
{AUTHOR_TESTING} ) ?
$ENV
{AUTHOR_TESTING} : 0;
};
subtest
'accept'
=>
sub
{
use
ok(
'HTTP::Promise::Headers::Accept'
);
my
$accept
=
'text/html, application/xhtml+xml, application/xml;q=0.9, image/webp, */*;q=0.8'
;
my
$h
= HTTP::Promise::Headers::Accept->new(
$accept
);
is(
$h
->elements->
length
, 5 );
is(
$h
->elements->first->element,
'text/html'
);
is(
$h
->elements->third->element,
'application/xml'
);
is(
$h
->elements->third->value, 0.9 );
is(
$h
->elements->fifth->element,
'*/*'
);
is(
$h
->elements->fifth->value, 0.8 );
is(
"$h"
,
$accept
);
my
$e
=
$h
->get(
'application/xml'
);
isa_ok(
$e
=> [
'HTTP::Promise::Field::QualityValue'
] );
is(
$e
->element,
'application/xml'
);
my
$e2
=
$h
->get(
$e
);
is(
$e2
->element,
$e
->element );
$h
->remove(
'application/xhtml+xml'
);
is(
$h
->as_string,
'text/html, application/xml;q=0.9, image/webp, */*;q=0.8'
);
is(
$h
->elements->first->value,
undef
);
$h
->
sort
;
is(
$h
->as_string,
'text/html, image/webp, application/xml;q=0.9, */*;q=0.8'
);
};
subtest
'accept-encoding'
=>
sub
{
use
ok(
'HTTP::Promise::Headers::AcceptEncoding'
);
my
$str
=
q{deflate, gzip;q=1.0, *;q=0.5}
;
my
$h
= HTTP::Promise::Headers::AcceptEncoding->new(
$str
);
is(
$h
->elements->
length
, 3 );
is(
$h
->elements->first->element,
'deflate'
);
is(
$h
->elements->third->value, 0.5 );
};
subtest
'accept-language'
=>
sub
{
use
ok(
'HTTP::Promise::Headers::AcceptLanguage'
);
my
$str
=
q{fr-FR, fr;q=0.9, en;q=0.8, de;q=0.7, *;q=0.5}
;
my
$h
= HTTP::Promise::Headers::AcceptLanguage->new(
$str
);
is(
$h
->elements->
length
, 5 );
is(
$h
->elements->first->element,
'fr-FR'
);
is(
$h
->elements->first->value,
undef
);
is(
$h
->elements->fourth->element,
'de'
);
is(
$h
->elements->fourth->value, 0.7 );
is(
$h
->elements->
last
->element,
'*'
);
};
subtest
'alt-svc'
=>
sub
{
use
ok(
'HTTP::Promise::Headers::AltSvc'
);
my
$str
=
q{h2="alt.example.com:443"; ma=2592000; persist=1}
;
my
$h
= HTTP::Promise::Headers::AltSvc->new(
$str
);
is(
$h
->protocol,
'h2'
);
is(
$h
->authority,
'alt.example.com:443'
);
is(
"$h"
,
$str
);
my
$h2
= HTTP::Promise::Headers::AltSvc->new( [
'w=x:y#z'
,
'new.example.org:443'
] );
is(
$h2
->protocol,
'w=x:y#z'
);
is(
$h2
->authority,
'new.example.org:443'
);
is(
"$h2"
,
q{w%3Dx%3Ay#z="new.example.org:443"}
);
};
subtest
'cache-control'
=>
sub
{
use
ok(
'HTTP::Promise::Headers::CacheControl'
);
my
$str
=
q{public, max-age=604800, immutable}
;
my
$h
= HTTP::Promise::Headers::CacheControl->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->public, 1 );
is(
$h
->max_age, 604800 );
is(
$h
->immutable, 1 );
$h
->max_age(
undef
);
is(
"$h"
,
q{public, immutable}
);
$h
->immutable(1);
is(
"$h"
,
q{public, immutable}
);
$h
->property(
'community'
=>
'UCI'
);
is(
"$h"
,
q{public, immutable, community="UCI"}
);
my
$v
=
$h
->property(
'community'
);
is(
$v
=>
'UCI'
);
$h
->property(
community
=>
undef
);
is(
"$h"
,
q{public, immutable}
);
};
subtest
'clear-site-data'
=>
sub
{
use
ok(
'HTTP::Promise::Headers::ClearSiteData'
);
my
$str
=
q{"cache", "cookies", "storage", "executionContexts"}
;
my
$h
= HTTP::Promise::Headers::ClearSiteData->new(
$str
);
is(
"$h"
,
$str
);
$h
->wildcard(1);
is(
"$h"
,
qq{${str}
,
"*"
} );
$h
->cache(0);
is(
"$h"
,
q{"cookies", "storage", "executionContexts", "*"}
);
$h
->cache(1);
is(
"$h"
,
q{"cookies", "storage", "executionContexts", "*", "cache"}
);
};
subtest
'content-disposition'
=>
sub
{
use
ok(
'HTTP::Promise::Headers::ContentDisposition'
);
my
$str
=
q{inline}
;
my
$h
= HTTP::Promise::Headers::ContentDisposition->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->disposition,
'inline'
);
$str
=
q{attachment}
;
$h
= HTTP::Promise::Headers::ContentDisposition->new(
$str
);
is(
$h
->disposition,
'attachment'
);
$str
=
q{attachment; filename="filename.jpg"}
;
$h
= HTTP::Promise::Headers::ContentDisposition->new(
$str
);
is(
$h
->disposition,
'attachment'
);
is(
$h
->filename,
'filename.jpg'
);
$str
=
q{form-data; name="fieldName"}
;
$h
= HTTP::Promise::Headers::ContentDisposition->new(
$str
);
is(
$h
->disposition,
'form-data'
);
is(
$h
->name,
'fieldName'
);
$str
=
q{form-data; name="fieldName"; filename="filename.jpg"}
;
$h
= HTTP::Promise::Headers::ContentDisposition->new(
$str
);
is(
$h
->disposition,
'form-data'
);
is(
$h
->name,
'fieldName'
);
is(
$h
->filename,
'filename.jpg'
);
$str
=
q{form-data; name="fieldName"; filename="filename.jpg"}
;
$str
=
q{attachment; filename*="UTF-8'ja-JP'%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB.txt"}
;
$h
= HTTP::Promise::Headers::ContentDisposition->new(
$str
);
is(
$h
->filename,
'ファイル.txt'
);
is(
$h
->filename_charset,
'UTF-8'
);
is(
$h
->filename_lang,
'ja-JP'
);
$h
= HTTP::Promise::Headers::ContentDisposition->new;
$h
->disposition(
'form-data'
);
$h
->name(
'someField'
);
is(
$h
->name,
'someField'
);
$h
->filename(
'マイファイル.txt'
,
'ja-JP'
);
is(
"$h"
,
q{form-data; name=someField; filename*=UTF-8'ja-JP'%E3%83%9E%E3%82%A4%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB.txt}
);
};
subtest
'content-range'
=>
sub
{
use
ok(
'HTTP::Promise::Headers::ContentRange'
);
my
$str
=
q{bytes 0-499/1234}
;
my
$h
= HTTP::Promise::Headers::ContentRange->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->unit,
'bytes'
);
is(
$h
->range_start, 0 );
is(
$h
->range_end, 499 );
is(
$h
->size, 1234 );
$str
=
q{bytes */1234}
;
$h
= HTTP::Promise::Headers::ContentRange->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->unit,
'bytes'
);
is(
$h
->range_start,
undef
,
'range_start'
);
is(
$h
->size, 1234 );
$str
=
q{bytes 42-1233/*}
;
$h
= HTTP::Promise::Headers::ContentRange->new(
$str
);
is(
"$h"
,
$str
,
'as_string'
);
is(
$h
->unit,
'bytes'
);
is(
$h
->range_start, 42 );
is(
$h
->range_end, 1233 );
is(
$h
->size,
'*'
);
};
subtest
'content-security-policy'
=>
sub
{
use
ok(
'HTTP::Promise::Headers::ContentSecurityPolicy'
);
my
$str
=
q{default-src 'self'}
;
my
$h
= HTTP::Promise::Headers::ContentSecurityPolicy->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->default_src,
"'self'"
);
$str
=
q{default-src 'self' trusted.com *.trusted.com}
;
$h
= HTTP::Promise::Headers::ContentSecurityPolicy->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->default_src,
q{'self' trusted.com *.trusted.com}
);
$h
= HTTP::Promise::Headers::ContentSecurityPolicy->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->block_all_mixed_content, 1 );
is(
$h
->default_src,
"'self'"
);
is(
$h
->img_src,
q{'self' img.example.com}
);
is(
$h
->plugin_types,
'application/x-shockwave-flash'
);
is(
$h
->referrer,
'"no-referrer"'
);
is(
$h
->report_to,
'csp-endpoint'
);
is(
$h
->require_sri_for,
'script style'
);
is(
$h
->require_trusted_types_for,
"'script'"
);
is(
$h
->sandbox, 1 );
is(
$h
->script_src,
q{'self' js.example.com}
);
is(
$h
->trusted_types, 1 );
is(
$h
->upgrade_insecure_requests, 1 );
$h
->block_all_mixed_content(0);
is(
$h
->block_all_mixed_content, 0 );
};
subtest
'content-type'
=>
sub
{
use
ok(
'HTTP::Promise::Headers::ContentType'
);
my
$str
=
q{text/html; charset=UTF-8}
;
my
$h
= HTTP::Promise::Headers::ContentType->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->type,
'text/html'
);
is(
$h
->charset,
'UTF-8'
);
$str
=
q{application/octet-stream}
;
$h
= HTTP::Promise::Headers::ContentType->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->type,
'application/octet-stream'
);
$str
=
q{multipart/form-data; boundary=something}
;
$h
= HTTP::Promise::Headers::ContentType->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->type,
'multipart/form-data'
);
is(
$h
->boundary,
'something'
);
$str
=
q{application/x-www-form-urlencoded}
;
$h
= HTTP::Promise::Headers::ContentType->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->type,
'application/x-www-form-urlencoded'
);
$str
=
q{multipart/byteranges}
;
$h
= HTTP::Promise::Headers::ContentType->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->type,
'multipart/byteranges'
);
$h
= HTTP::Promise::Headers::ContentType->new;
$h
->type(
'text/plain'
);
$h
->charset(
'utf-8'
);
is(
"$h"
,
'text/plain; charset=utf-8'
);
};
subtest
'expect-ct'
=>
sub
{
use
ok(
'HTTP::Promise::Headers::ExpectCT'
);
my
$h
= HTTP::Promise::Headers::ExpectCT->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->max_age, 86400 );
is(
$h
->enforce, 1 );
};
subtest
'forwarded'
=>
sub
{
use
ok(
'HTTP::Promise::Headers::Forwarded'
);
my
$str
=
q{for=192.0.2.60; proto=http; by=203.0.113.43}
;
my
$h
= HTTP::Promise::Headers::Forwarded->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->
for
,
'192.0.2.60'
);
is(
$h
->proto,
'http'
);
is(
$h
->by,
'203.0.113.43'
);
};
subtest
'keep-alive'
=>
sub
{
use
ok(
'HTTP::Promise::Headers::KeepAlive'
);
my
$str
=
q{timeout=5, max=1000}
;
my
$h
= HTTP::Promise::Headers::KeepAlive->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->timeout, 5 );
is(
$h
->max, 1000 );
};
subtest
'link'
=>
sub
{
use
ok(
'HTTP::Promise::Headers::Link'
);
my
$h
= HTTP::Promise::Headers::Link->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->rel,
'preconnect'
);
$h
= HTTP::Promise::Headers::Link->new;
$h
->rel(
'next'
);
$h
->title(
'別に'
,
'ja-JP'
);
$h
->anchor(
'#baz'
);
};
subtest
'range'
=>
sub
{
use
ok(
'HTTP::Promise::Headers::Range'
);
my
$str
=
q{bytes=200-1000, 1001-2000, 2001-3000}
;
my
$h
= HTTP::Promise::Headers::Range->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->ranges->first->start, 200 );
is(
$h
->ranges->first->end, 1000 );
is(
$h
->ranges->second->start, 1001 );
is(
$h
->ranges->second->end, 2000 );
is(
$h
->ranges->third->start, 2001 );
is(
$h
->ranges->third->end, 3000 );
$str
=
q{bytes=200-}
;
$h
= HTTP::Promise::Headers::Range->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->ranges->first->start, 200 );
is(
$h
->ranges->first->end,
undef
);
$str
=
q{bytes=-4321}
;
$h
= HTTP::Promise::Headers::Range->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->ranges->first->start,
undef
);
is(
$h
->ranges->first->end, 4321 );
};
subtest
'server-timing'
=>
sub
{
use
ok(
'HTTP::Promise::Headers::ServerTiming'
);
my
$str
=
q{cache; desc="Cache Read"; dur=23.2}
;
my
$h
= HTTP::Promise::Headers::ServerTiming->new(
$str
);
is(
"$h"
,
$str
);
$h
= HTTP::Promise::Headers::ServerTiming->new;
$h
->name(
'db'
);
$h
->dur( 3.2 );
$h
->desc(
'Some database'
);
is(
"$h"
,
'db; desc="Some database"; dur=3.2'
);
};
subtest
'strict-transport-security'
=>
sub
{
use
ok(
'HTTP::Promise::Headers::StrictTransportSecurity'
);
my
$str
=
q{max-age=63072000; includeSubDomains; preload}
;
my
$h
= HTTP::Promise::Headers::StrictTransportSecurity->new(
$str
);
is(
"$h"
,
$str
);
is(
$h
->max_age, 63072000 );
is(
$h
->include_subdomains, 1 );
is(
$h
->preload, 1 );
$h
->include_subdomains(
undef
);
is(
"$h"
,
q{max-age=63072000; preload}
);
$h
= HTTP::Promise::Headers::StrictTransportSecurity->new;
$h
->include_subdomains(1);
$h
->max_age(63072000);
$h
->preload(1);
$h
->property_boolean(
'something_else'
=> 1 );
is(
"$h"
,
q{includeSubDomains; max-age=63072000; preload; something_else}
);
is(
$h
->max_age, 63072000 );
is(
$h
->preload, 1 );
};
subtest
'te'
=>
sub
{
use
ok(
'HTTP::Promise::Headers::TE'
);
my
$str
=
q{trailers, deflate;q=0.5}
;
my
$h
= HTTP::Promise::Headers::TE->new(
$str
);
is(
"$h"
,
$str
);
my
$e
=
$h
->get(
'trailers'
);
isa_ok(
$e
=> [
'HTTP::Promise::Field::QualityValue'
] );
is(
$e
->element,
'trailers'
);
is(
$e
->value,
undef
);
my
$e2
=
$h
->get(
'deflate'
);
isa_ok(
$e2
=> [
'HTTP::Promise::Field::QualityValue'
] );
is(
$e2
->element,
'deflate'
);
is(
$e2
->value, 0.5 );
ok(
$e2
->value >
$e
->value );
ok( !(
$e2
->value <
$e
->value ) );
};
subtest
'want-digest'
=>
sub
{
use
ok(
'HTTP::Promise::Headers::WantDigest'
);
my
$str
=
q{SHA-512;q=0.3, sha-256;q=1, md5;q=0}
;
my
$h
= HTTP::Promise::Headers::WantDigest->new(
$str
);
is(
"$h"
,
$str
);
my
$e
=
$h
->get(
'SHA-512'
);
isa_ok(
$e
=> [
'HTTP::Promise::Field::QualityValue'
] );
};
subtest
"new_field"
=>
sub
{
use
ok(
'HTTP::Promise::Headers'
);
my
$h
= HTTP::Promise::Headers->new;
my
%tests
= (
accept_encoding
=>
'HTTP::Promise::Headers::AcceptEncoding'
,
accept_language
=>
'HTTP::Promise::Headers::AcceptLanguage'
,
accept
=>
'HTTP::Promise::Headers::Accept'
,
altsvc
=>
'HTTP::Promise::Headers::AltSvc'
,
cache_control
=>
'HTTP::Promise::Headers::CacheControl'
,
clear_site_data
=>
'HTTP::Promise::Headers::ClearSiteData'
,
content_disposition
=>
'HTTP::Promise::Headers::ContentDisposition'
,
content_range
=>
'HTTP::Promise::Headers::ContentRange'
,
content_securit_ypolicy
=>
'HTTP::Promise::Headers::ContentSecurityPolicy'
,
content_security_policy_report_only
=>
'HTTP::Promise::Headers::ContentSecurityPolicyReportOnly'
,
content_type
=>
'HTTP::Promise::Headers::ContentType'
,
cookie
=>
'HTTP::Promise::Headers::Cookie'
,
expectct
=>
'HTTP::Promise::Headers::ExpectCT'
,
forwarded
=>
'HTTP::Promise::Headers::Forwarded'
,
generic
=>
'HTTP::Promise::Headers::Generic'
,
keepalive
=>
'HTTP::Promise::Headers::KeepAlive'
,
link
=>
'HTTP::Promise::Headers::Link'
,
range
=>
'HTTP::Promise::Headers::Range'
,
server_timing
=>
'HTTP::Promise::Headers::ServerTiming'
,
strict_transport_security
=>
'HTTP::Promise::Headers::StrictTransportSecurity'
,
te
=>
'HTTP::Promise::Headers::TE'
,
wantdigest
=>
'HTTP::Promise::Headers::WantDigest'
,
);
foreach
(
sort
(
keys
(
%tests
) ) )
{
my
$f
=
$h
->new_field(
$_
) ||
do
{
diag(
"Failed instantiating an object for \"$_\": "
,
$h
->error )
if
(
$DEBUG
);
fail(
$tests
{
$_
} );
next
;
};
isa_ok(
$f
, [
$tests
{
$_
} ] );
}
};
done_testing();