HTTP-Headers-ActionPack-0.09/0000775000175000017500000000000012160126437015450 5ustar autarchautarchHTTP-Headers-ActionPack-0.09/MANIFEST0000644000175000017500000000334012160126437016577 0ustar autarchautarchChanges INSTALL LICENSE MANIFEST META.json META.yml Makefile.PL README README.md dist.ini eg/torture-test lib/HTTP/Headers/ActionPack.pm lib/HTTP/Headers/ActionPack/AcceptCharset.pm lib/HTTP/Headers/ActionPack/AcceptLanguage.pm lib/HTTP/Headers/ActionPack/AuthenticationInfo.pm lib/HTTP/Headers/ActionPack/Authorization.pm lib/HTTP/Headers/ActionPack/Authorization/Basic.pm lib/HTTP/Headers/ActionPack/Authorization/Digest.pm lib/HTTP/Headers/ActionPack/ContentNegotiation.pm lib/HTTP/Headers/ActionPack/Core/Base.pm lib/HTTP/Headers/ActionPack/Core/BaseAuthHeader.pm lib/HTTP/Headers/ActionPack/Core/BaseHeaderList.pm lib/HTTP/Headers/ActionPack/Core/BaseHeaderType.pm lib/HTTP/Headers/ActionPack/Core/BaseHeaderWithParams.pm lib/HTTP/Headers/ActionPack/DateHeader.pm lib/HTTP/Headers/ActionPack/LinkHeader.pm lib/HTTP/Headers/ActionPack/LinkList.pm lib/HTTP/Headers/ActionPack/MediaType.pm lib/HTTP/Headers/ActionPack/MediaTypeList.pm lib/HTTP/Headers/ActionPack/PriorityList.pm lib/HTTP/Headers/ActionPack/Util.pm lib/HTTP/Headers/ActionPack/WWWAuthenticate.pm t/000-load.t t/001-basic.t t/002-http-headers-inflate.t t/003-create-header-auth.t t/004-inflate.t t/010-media-type.t t/020-priority-list.t t/030-media-type-list.t t/040-link.t t/050-date.t t/060-www-authenticate.t t/061-authentication-info.t t/070-authorization.t t/071-basic-authorization.t t/072-digest-authorization.t t/100-http-headers.t t/101-http-request.t t/102-http-response.t t/200-plack.t t/300-content-negotiation-media-type.t t/301-content-negotiation-language.t t/302-content-negotiation-charset.t t/303-content-negotiation-encoding.t t/400-undef-warnings.t t/author-pod-spell.t t/release-no-tabs.t t/release-pod-linkcheck.t t/release-pod-no404s.t t/release-pod-syntax.t weaver.ini HTTP-Headers-ActionPack-0.09/t/0000775000175000017500000000000012160126437015713 5ustar autarchautarchHTTP-Headers-ActionPack-0.09/t/010-media-type.t0000644000175000017500000001335012160126437020434 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { use_ok('HTTP::Headers::ActionPack::MediaType'); } sub test_media_type { my $media_type = shift; isa_ok($media_type, 'HTTP::Headers::ActionPack::MediaType'); is($media_type->type, 'application/xml', '... got the right type'); is_deeply( $media_type->params, { 'charset' => 'UTF-8' }, '... got the right params' ); is($media_type->major, 'application', '... got the right major portion'); is($media_type->minor, 'xml', '... got the right minor portion'); is($media_type->as_string, 'application/xml; charset="UTF-8"', '... the string representation'); my $media_type_2 = HTTP::Headers::ActionPack::MediaType->new('application/xml', => ( 'charset' => 'UTF-8' )); isa_ok($media_type_2, 'HTTP::Headers::ActionPack::MediaType'); is($media_type_2->as_string, 'application/xml; charset="UTF-8"', '... the string representation'); ok($media_type->equals( $media_type_2 ), '... these types are equal'); ok($media_type->equals('application/xml; charset=UTF-8'), '... these types are equal'); ok(!$media_type->matches_all, '... this is not a matches_all type'); ok($media_type->exact_match('application/xml;charset=UTF-8'), '... these types are an exact match'); ok($media_type->exact_match('application/*;charset=UTF-8'), '... these types are an exact match'); ok($media_type->exact_match('*/*;charset=UTF-8'), '... these types are an exact match'); ok(!$media_type->exact_match('application/json;charset=UTF-8'), '... these types are not an exact match'); ok(!$media_type->exact_match('application/xml;charset=Latin-1'), '... these types are not an exact match'); ok($media_type->match('application/xml'), '... these types are a match'); ok(!$media_type->match('application/xml;charset=UTF-8;version=1'), '... these types are not a match'); ok(!$media_type->match('application/*;charset=UTF-8;version=1'), '... these types are not a match'); ok(!$media_type->match('*/*;charset=UTF-8;version=1'), '... these types are a match'); ok(!$media_type->match('application/xml;charset=Latin-1;version=1'), '... these types are not a match'); ok(!$media_type->match('application/json;charset=UTF-8;version=1'), '... these types are not a match'); } test_media_type( HTTP::Headers::ActionPack::MediaType->new_from_string('application/xml;charset=UTF-8') ); test_media_type( HTTP::Headers::ActionPack::MediaType->new('application/xml', 'charset' => 'UTF-8') ); { my $matches_all = HTTP::Headers::ActionPack::MediaType->new_from_string('*/*'); is($matches_all->type, '*/*', '... got the right type'); is_deeply( $matches_all->params, {}, '... got the right params' ); is($matches_all->as_string, '*/*', '... the string representation'); ok($matches_all->matches_all, '... this type does match all'); } { my $multiline = HTTP::Headers::ActionPack::MediaType->new_from_string(q[multipart/form-data; boundary=----------------------------2c46a7bec2b9]); is($multiline->type, 'multipart/form-data', '... got the right type'); is_deeply( $multiline->params, { 'boundary' => '----------------------------2c46a7bec2b9' }, '... got the right params' ); is($multiline->as_string, 'multipart/form-data; boundary="----------------------------2c46a7bec2b9"', '... the string representation'); } # test multiple params ... { my $mt = HTTP::Headers::ActionPack::MediaType->new_from_string('application/json;v= 3;foo=bar'); is($mt->type, 'application/json', '... got the right type'); is_deeply( $mt->params, { v => 3, foo => 'bar' }, '... got the right params' ); is($mt->as_string, 'application/json; v="3"; foo="bar"', '... got the right string representation'); } # test a lot of params ... { my $mt = HTTP::Headers::ActionPack::MediaType->new_from_string('application/json; v=3;foo=bar;q=0.25;testing=123'); is($mt->type, 'application/json', '... got the right type'); is_deeply( $mt->params, { v => 3, foo => 'bar', q => 0.25, testing => 123 }, '... got the right params' ); is($mt->as_string, 'application/json; v="3"; foo="bar"; q="0.25"; testing="123"', '... got the right string representation'); } # test with quoted strings { my $mt = HTTP::Headers::ActionPack::MediaType->new_from_string('application/json; v=3; foo=bar; q="0.25"; testing="1,23"'); is($mt->type, 'application/json', '... got the right type'); is_deeply( $mt->params, { v => 3, foo => 'bar', q => 0.25, testing => '1,23' }, '... got the right params' ); is($mt->as_string, 'application/json; v="3"; foo="bar"; q="0.25"; testing="1,23"', '... got the right string representation'); } { my $mt = HTTP::Headers::ActionPack::MediaType->new_from_string('application/json; v=3; foo=bar; q=0.25; testing="1;23"'); is($mt->type, 'application/json', '... got the right type'); is_deeply( $mt->params, { v => 3, foo => 'bar', q => 0.25, testing => '1;23' }, '... got the right params' ); is($mt->as_string, 'application/json; v="3"; foo="bar"; q="0.25"; testing="1;23"', '... got the right string representation'); } { my $mt = HTTP::Headers::ActionPack::MediaType->new_from_string('application/json; v=3; foo=bar; q=0.25; testing="12\"3\""'); is($mt->type, 'application/json', '... got the right type'); is_deeply( $mt->params, { v => 3, foo => 'bar', q => 0.25, testing => '12"3"' }, '... got the right params' ); is($mt->as_string, 'application/json; v="3"; foo="bar"; q="0.25"; testing="12\"3\""', '... got the right string representation'); } done_testing; HTTP-Headers-ActionPack-0.09/t/release-no-tabs.t0000644000175000017500000000045012160126437021056 0ustar autarchautarch BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use strict; use warnings; use Test::More; eval 'use Test::NoTabs'; plan skip_all => 'Test::NoTabs required' if $@; all_perl_files_ok(); HTTP-Headers-ActionPack-0.09/t/050-date.t0000644000175000017500000000156612160126437017325 0ustar autarchautarch #!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { use_ok('HTTP::Headers::ActionPack::DateHeader'); } sub test_date { my $h = shift; isa_ok($h, 'HTTP::Headers::ActionPack::DateHeader'); is( $h->day, 'Mon', '... got the day'); is( $h->month, 'Apr', '... got the month'); is( $h->year, 2012, '... got the year'); is( $h->hour, 14, '... got the hour'); is( $h->minute, 14, '... got the minute'); is( $h->second, 19, '... got the second'); is( $h->as_string, 'Mon, 23 Apr 2012 14:14:19 GMT', '... got the expected string'); } test_date( HTTP::Headers::ActionPack::DateHeader->new_from_string('Mon, 23 Apr 2012 14:14:19 GMT') ); test_date( HTTP::Headers::ActionPack::DateHeader->new( scalar Time::Piece->gmtime( HTTP::Date::str2time( 'Mon, 23 Apr 2012 14:14:19 GMT' ) ) ) ); done_testing;HTTP-Headers-ActionPack-0.09/t/060-www-authenticate.t0000644000175000017500000000415312160126437021704 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { use_ok('HTTP::Headers::ActionPack::WWWAuthenticate'); } sub test_basic { my $www_authen = shift; is($www_authen->auth_type, 'Basic', '... got the right auth type'); is($www_authen->realm, 'WallyWorld', '... got the right realm'); is_deeply( $www_authen->params, { realm => 'WallyWorld' }, '... got the parameters we expected' ); is($www_authen->as_string, 'Basic realm="WallyWorld"', '... got the right stringification'); } sub test_digest { my $www_authen = shift; is($www_authen->auth_type, 'Digest', '... got the right auth type'); is($www_authen->realm, 'testrealm@host.com', '... got the right realm'); is_deeply( $www_authen->params, { realm => 'testrealm@host.com', qop => "auth,auth-int", nonce => "dcd98b7102dd2f0e8b11d0f600bfb0c093", opaque => "5ccc069c403ebaf9f0171e9517f40e41" }, '... got the parameters we expected' ); is( $www_authen->as_string, 'Digest realm="testrealm@host.com", qop="auth,auth-int", nonce="dcd98b7102dd2f0e8b11d0f600bfb0c093", opaque="5ccc069c403ebaf9f0171e9517f40e41"', '... got the right stringification' ); } test_basic( HTTP::Headers::ActionPack::WWWAuthenticate->new_from_string( 'Basic realm="WallyWorld"' ) ); test_basic( HTTP::Headers::ActionPack::WWWAuthenticate->new( 'Basic' => ( realm => "WallyWorld" ) ) ); test_digest( HTTP::Headers::ActionPack::WWWAuthenticate->new_from_string( 'Digest realm="testrealm@host.com", qop="auth,auth-int", nonce="dcd98b7102dd2f0e8b11d0f600bfb0c093", opaque="5ccc069c403ebaf9f0171e9517f40e41"' ) ); test_digest( HTTP::Headers::ActionPack::WWWAuthenticate->new( 'Digest' => ( realm => 'testrealm@host.com', qop => "auth,auth-int", nonce => "dcd98b7102dd2f0e8b11d0f600bfb0c093", opaque => "5ccc069c403ebaf9f0171e9517f40e41" ) ) ); done_testing;HTTP-Headers-ActionPack-0.09/t/030-media-type-list.t0000644000175000017500000000601412160126437021406 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { use_ok('HTTP::Headers::ActionPack::MediaTypeList'); } { my $list = HTTP::Headers::ActionPack::MediaTypeList->new( HTTP::Headers::ActionPack::MediaType->new('audio/*', q => 0.2 ), HTTP::Headers::ActionPack::MediaType->new('audio/basic', q => 1.0 ) ); isa_ok($list, 'HTTP::Headers::ActionPack::MediaTypeList'); is( $list->as_string, 'audio/basic; q="1", audio/*; q="0.2"', '... got the expected string back' ); } { my $list = HTTP::Headers::ActionPack::MediaTypeList->new( [ 0.2 => HTTP::Headers::ActionPack::MediaType->new('audio/*', q => 0.2 ) ], [ 1.0 => HTTP::Headers::ActionPack::MediaType->new('audio/basic' ) ] ); isa_ok($list, 'HTTP::Headers::ActionPack::MediaTypeList'); is( $list->as_string, 'audio/basic, audio/*; q="0.2"', '... got the expected string back' ); } { my $list = HTTP::Headers::ActionPack::MediaTypeList->new_from_string( 'audio/*; q=0.2, audio/basic' ); isa_ok($list, 'HTTP::Headers::ActionPack::MediaTypeList'); is( $list->as_string, 'audio/basic, audio/*; q="0.2"', '... got the expected string back' ); } { my $list = HTTP::Headers::ActionPack::MediaTypeList->new_from_string( 'text/plain; q=0.5, text/html, text/x-dvi; q=0.8, text/x-c' ); isa_ok($list, 'HTTP::Headers::ActionPack::MediaTypeList'); is( $list->as_string, 'text/html, text/x-c, text/x-dvi; q="0.8", text/plain; q="0.5"', '... got the expected string back' ); } { my $list = HTTP::Headers::ActionPack::MediaTypeList->new_from_string( 'text/*, text/html, text/html;level=1, */*' ); isa_ok($list, 'HTTP::Headers::ActionPack::MediaTypeList'); is( $list->as_string, 'text/html; level="1", text/html, text/*, */*', '... got the expected string back' ); } { my $list = HTTP::Headers::ActionPack::MediaTypeList->new_from_string( 'text/html;charset=iso8859-1, application/xml' ); isa_ok($list, 'HTTP::Headers::ActionPack::MediaTypeList'); is( $list->as_string, 'text/html; charset="iso8859-1", application/xml', '... got the expected string back' ); } { my $list = HTTP::Headers::ActionPack::MediaTypeList->new_from_string( 'application/xml;q=0.7, text/html, */*' ); isa_ok($list, 'HTTP::Headers::ActionPack::MediaTypeList'); is( $list->as_string, 'text/html, */*, application/xml; q="0.7"', '... got the expected string back' ); } { my $list = HTTP::Headers::ActionPack::MediaTypeList->new_from_string( 'application/json;v=3;foo=bar, application/json;v=2' ); isa_ok($list, 'HTTP::Headers::ActionPack::MediaTypeList'); is( $list->as_string, 'application/json; v="2", application/json; v="3"; foo="bar"', '... got the expected string back' ); } done_testing;HTTP-Headers-ActionPack-0.09/t/102-http-response.t0000644000175000017500000000563112160126437021216 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use HTTP::Response; use HTTP::Headers; BEGIN { use_ok('HTTP::Headers::ActionPack::DateHeader'); use_ok('HTTP::Headers::ActionPack::LinkHeader'); use_ok('HTTP::Headers::ActionPack::LinkList'); use_ok('HTTP::Headers::ActionPack::MediaType'); } =pod This just tests that HTTP::Response does not stringify our objects until we ask it to. =cut { my $r = HTTP::Response->new( 200, 'OK', HTTP::Headers->new( Date => HTTP::Headers::ActionPack::DateHeader->new_from_string('Mon, 23 Apr 2012 14:14:19 GMT'), Content_Type => HTTP::Headers::ActionPack::MediaType->new('application/xml', 'charset' => 'UTF-8'), Link => HTTP::Headers::ActionPack::LinkList->new( HTTP::Headers::ActionPack::LinkHeader->new( 'http://example.com/TheBook/chapter2' => ( rel => "previous", title => "previous chapter" ) ) ) ) ); isa_ok($r->header('Date'), 'HTTP::Headers::ActionPack::DateHeader', '... object is preserved and'); isa_ok($r->header('Content-Type'), 'HTTP::Headers::ActionPack::MediaType', '... object is preserved and'); isa_ok($r->header('Link'), 'HTTP::Headers::ActionPack::LinkList', '... object is preserved and'); is( $r->as_string, q{200 OK Date: Mon, 23 Apr 2012 14:14:19 GMT Content-Type: application/xml; charset="UTF-8" Link: ; rel="previous"; title="previous chapter" }, '... got the stringified headers' ); } { my $r = HTTP::Response->new( 200, 'OK', [ Date => HTTP::Headers::ActionPack::DateHeader->new_from_string('Mon, 23 Apr 2012 14:14:19 GMT'), Content_Type => HTTP::Headers::ActionPack::MediaType->new('application/xml', 'charset' => 'UTF-8'), Link => HTTP::Headers::ActionPack::LinkList->new( HTTP::Headers::ActionPack::LinkHeader->new( 'http://example.com/TheBook/chapter2' => ( rel => "previous", title => "previous chapter" ) ) ) ] ); isa_ok($r->header('Date'), 'HTTP::Headers::ActionPack::DateHeader', '... object is preserved and'); isa_ok($r->header('Content-Type'), 'HTTP::Headers::ActionPack::MediaType', '... object is preserved and'); isa_ok($r->header('Link'), 'HTTP::Headers::ActionPack::LinkList', '... object is preserved and'); is( $r->as_string, q{200 OK Date: Mon, 23 Apr 2012 14:14:19 GMT Content-Type: application/xml; charset="UTF-8" Link: ; rel="previous"; title="previous chapter" }, '... got the stringified headers' ); } done_testing;HTTP-Headers-ActionPack-0.09/t/author-pod-spell.t0000644000175000017500000000152512160126437021300 0ustar autarchautarch BEGIN { unless ($ENV{AUTHOR_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for testing by the author'); } } use strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::PodSpelling 2.004003 eval "use Test::Spelling 0.12; use Pod::Wordlist::hanekomu; 1" or die $@; add_stopwords(); all_pod_files_spelling_ok( qw( bin lib ) ); __DATA__ Auth Charset Etheridge Luehrs Ragwitz Rolsky TW invocant invocants stringifying subclasses unordered utf zh Stevan Little stevan Infinity Interactive Inc lib HTTP Headers ActionPack Core BaseAuthHeader Authorization AuthenticationInfo Base AcceptCharset AcceptLanguage BaseHeaderList BaseHeaderType Digest MediaType WWWAuthenticate DateHeader PriorityList MediaTypeList Basic ContentNegotiation LinkList LinkHeader BaseHeaderWithParams Util HTTP-Headers-ActionPack-0.09/t/072-digest-authorization.t0000644000175000017500000000456312160126437022571 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { use_ok('HTTP::Headers::ActionPack::Authorization::Digest'); } sub test_auth { my $auth = shift; is($auth->auth_type, 'Digest', '... got the right auth type'); is($auth->username, 'jon.dough@mobile.biz', '... got the right username'); is($auth->realm, 'RoamingUsers@mobile.biz', '... got the right realm'); is_deeply( $auth->params, { username => 'jon.dough@mobile.biz', realm => 'RoamingUsers@mobile.biz', nonce => "CjPk9mRqNuT25eRkajM09uTl9nM09uTl9nMz5OX25PZz==", uri => "sip:home.mobile.biz", qop => 'auth-int', nc => '00000001', cnonce => "0a4f113b", response => "6629fae49393a05397450978507c4ef1", opaque => "5ccc069c403ebaf9f0171e9517f40e41" }, '... got the right params list' ); is( $auth->as_string, q{Digest username="jon.dough@mobile.biz", realm="RoamingUsers@mobile.biz", nonce="CjPk9mRqNuT25eRkajM09uTl9nM09uTl9nMz5OX25PZz==", uri="sip:home.mobile.biz", qop="auth-int", nc="00000001", cnonce="0a4f113b", response="6629fae49393a05397450978507c4ef1", opaque="5ccc069c403ebaf9f0171e9517f40e41"}, '... got the right stringification' ); } test_auth( HTTP::Headers::ActionPack::Authorization::Digest->new_from_string( q{Digest username="jon.dough@mobile.biz", realm="RoamingUsers@mobile.biz", nonce="CjPk9mRqNuT25eRkajM09uTl9nM09uTl9nMz5OX25PZz==", uri="sip:home.mobile.biz", qop=auth-int, nc=00000001, cnonce="0a4f113b", response="6629fae49393a05397450978507c4ef1", opaque="5ccc069c403ebaf9f0171e9517f40e41"} ) ); test_auth( HTTP::Headers::ActionPack::Authorization::Digest->new( 'Digest' => ( username => 'jon.dough@mobile.biz', realm => 'RoamingUsers@mobile.biz', nonce => "CjPk9mRqNuT25eRkajM09uTl9nM09uTl9nMz5OX25PZz==", uri => "sip:home.mobile.biz", qop => 'auth-int', nc => '00000001', cnonce => "0a4f113b", response => "6629fae49393a05397450978507c4ef1", opaque => "5ccc069c403ebaf9f0171e9517f40e41" ) ) ); done_testing;HTTP-Headers-ActionPack-0.09/t/300-content-negotiation-media-type.t0000644000175000017500000001326012160126437024424 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { use_ok('HTTP::Headers::ActionPack'); } my $n = HTTP::Headers::ActionPack->new->get_content_negotiator; isa_ok($n, 'HTTP::Headers::ActionPack::ContentNegotiation'); is( $n->choose_media_type( [], '*/*' ), undef, '... got nothing back (no choices)' ); is( $n->choose_media_type( ["text/html"], 'application/json' ), undef, '... got nothing back (no matches)' ); # Examples from http://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html =pod The example Accept: audio/*; q=0.2, audio/basic SHOULD be interpreted as "I prefer audio/basic, but send me any audio type if it is the best available after an 80% mark-down in quality." =cut is( $n->choose_media_type( ["audio/basic", "audio/oog"], "audio/*; q=0.2, audio/basic" ), 'audio/basic', '... got the right media type back (prefer audio/basic)' ); isa_ok( $n->choose_media_type( ["audio/basic", "audio/oog"], "audio/*; q=0.2, audio/basic" ), 'HTTP::Headers::ActionPack::MediaType', '... got back the object actually ->' ); is( $n->choose_media_type( ["audio/mp3", "audio/oog"], "audio/*; q=0.2, audio/basic" ), 'audio/mp3', '... got the right media type back (prefer audio/* and choose audio/mp3)' ); =pod A more elaborate example is Accept: text/plain; q=0.5, text/html, text/x-dvi; q=0.8, text/x-c Verbally, this would be interpreted as "text/html and text/x-c are the preferred media types, but if they do not exist, then send the text/x-dvi entity, and if that does not exist, send the text/plain entity." =cut is( $n->choose_media_type( ["text/html", "text/plain"], "text/plain; q=0.5, text/html, text/x-dvi; q=0.8, text/x-c" ), 'text/html', '... got the right media type back (prefer text/html over lesser quality options)' ); is( $n->choose_media_type( ["text/html", "text/x-dvi"], "text/plain; q=0.5, text/html, text/x-dvi; q=0.8, text/x-c" ), 'text/html', '... got the right media type back (prefer text/html over lesser quality options)' ); is( $n->choose_media_type( ["text/x-c", "text/plain"], "text/plain; q=0.5, text/html, text/x-dvi; q=0.8, text/x-c" ), 'text/x-c', '... got the right media type back (prefer text/x-c over lesser quality options)' ); is( $n->choose_media_type( ["text/x-c", "text/x-dvi"], "text/plain; q=0.5, text/html, text/x-dvi; q=0.8, text/x-c" ), 'text/x-c', '... got the right media type back (prefer text/x-c over lesser quality options)' ); is( $n->choose_media_type( ["text/x-c", "text/html"], "text/plain; q=0.5, text/html, text/x-dvi; q=0.8, text/x-c" ), 'text/html', '... got the right media type back (prefer text/html over text/x-c)' ); is( $n->choose_media_type( ["text/sgml", "text/x-dvi"], "text/plain; q=0.5, text/html, text/x-dvi; q=0.8, text/x-c" ), 'text/x-dvi', '... got the right media type back (accept text/x-dvi)' ); is( $n->choose_media_type( ["text/sgml", "text/plain", "text/x-dvi"], "text/plain; q=0.5, text/html, text/x-dvi; q=0.8, text/x-c" ), 'text/x-dvi', '... got the right media type back (prefer text/x-dvi over text/plain)' ); is( $n->choose_media_type( ["text/sgml", "text/plain", ], "text/plain; q=0.5, text/html, text/x-dvi; q=0.8, text/x-c" ), 'text/plain', '... got the right media type back (accept text/plain)' ); =pod Media ranges can be overridden by more specific media ranges or specific media types. If more than one media range applies to a given type, the most specific reference has precedence. For example, Accept: text/*, text/html, text/html;level=1, */* have the following precedence: 1) text/html;level=1 2) text/html 3) text/* 4) */* =cut is( $n->choose_media_type( ["text/html", "text/html;level=1" ], "text/*, text/html, text/html;level=1, */*" ), 'text/html; level="1"', '... got the right media type back (prefer text/html;level=1 because it is more specific)' ); is( $n->choose_media_type( ["text/plain", "text/html" ], "text/*, text/html, text/html;level=1, */*" ), 'text/html', '... got the right media type back (prefer text/html to other less specific options)' ); # Examples from webmachine-ruby is( $n->choose_media_type( ["text/html", "application/xml"], "application/xml, text/html, */*" ), 'application/xml', '... got the right media type back (choose application/xml because of header ordering)' ); is( $n->choose_media_type( ["text/html", "text/html;charset=iso8859-1" ], "text/html;charset=iso8859-1, application/xml" ), 'text/html; charset="iso8859-1"', '... got the right media type back (choose the more specific text/html;charset=iso8859-1)' ); is( $n->choose_media_type( ["application/json;v=3;foo=bar", "application/json;v=2"], "text/html, application/json" ), 'application/json; v="3"; foo="bar"', '... got the right media type back (choose application/json;v=3;foo=bar because of preference ordering)' ); is( $n->choose_media_type( ["text/html", "application/xml"], "application/xml;q=0.7, text/html, */*" ), 'text/html', '... got the right media type back (choose text/html because of quality level and preference ordering)' ); is( $n->choose_media_type( ["text/html", "application/xml"], "bah" ), undef, '... got no media type back' ); done_testing; HTTP-Headers-ActionPack-0.09/t/061-authentication-info.t0000644000175000017500000000212012160126437022345 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { use_ok('HTTP::Headers::ActionPack::AuthenticationInfo'); } sub test_auth_info { my $auth_info = shift; is_deeply( $auth_info->params, { qop => 'auth-int', rspauth => "6629fae49393a05397450978507c4ef1", cnonce => "0a4f113b", nc => '00000001' }, '... got the expected params' ); is( $auth_info->as_string, 'qop="auth-int", rspauth="6629fae49393a05397450978507c4ef1", cnonce="0a4f113b", nc="00000001"', '... got the right stringification' ); } test_auth_info( HTTP::Headers::ActionPack::AuthenticationInfo->new_from_string( 'qop=auth-int, rspauth="6629fae49393a05397450978507c4ef1", cnonce="0a4f113b", nc=00000001' ) ); test_auth_info( HTTP::Headers::ActionPack::AuthenticationInfo->new( qop => 'auth-int', rspauth => "6629fae49393a05397450978507c4ef1", cnonce => "0a4f113b", nc => '00000001' ) ); done_testing;HTTP-Headers-ActionPack-0.09/t/release-pod-linkcheck.t0000644000175000017500000000077512160126437022240 0ustar autarchautarch#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use strict; use warnings; use Test::More; foreach my $env_skip ( qw( SKIP_POD_LINKCHECK ) ){ plan skip_all => "\$ENV{$env_skip} is set, skipping" if $ENV{$env_skip}; } eval "use Test::Pod::LinkCheck"; if ( $@ ) { plan skip_all => 'Test::Pod::LinkCheck required for testing POD'; } else { Test::Pod::LinkCheck->new->all_pod_ok; } HTTP-Headers-ActionPack-0.09/t/001-basic.t0000644000175000017500000000563112160126437017462 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { use_ok('HTTP::Headers::ActionPack'); } my $pack = HTTP::Headers::ActionPack->new; isa_ok($pack, 'HTTP::Headers::ActionPack'); { my $media_type = $pack->create_header( 'Content-Type' => 'application/xml;charset=UTF-8' ); isa_ok($media_type, 'HTTP::Headers::ActionPack::MediaType'); is($media_type->as_string, 'application/xml; charset="UTF-8"', '... got the right string'); my $links = $pack->create_header( 'Link' => '; tag="child", ; tag="child", ; rel="up"'); isa_ok($links, 'HTTP::Headers::ActionPack::LinkList'); is($links->as_string, '; tag="child", ; tag="child", ; rel="up"', '... got the right string'); } { my $media_type = $pack->create_header( 'Content-Type' => [ 'application/xml', charset => 'UTF-8' ] ); isa_ok($media_type, 'HTTP::Headers::ActionPack::MediaType'); is($media_type->as_string, 'application/xml; charset="UTF-8"', '... got the right string'); my $links = $pack->create_header( 'Link' => [ $pack->create( 'LinkHeader' => [ '', tag => "child" ] ), $pack->create( 'LinkHeader' => [ '', tag => "child" ] ), $pack->create( 'LinkHeader' => [ '', rel => "up" ] ), ]); isa_ok($links, 'HTTP::Headers::ActionPack::LinkList'); is($links->as_string, '; tag="child", ; tag="child", ; rel="up"', '... got the right string'); } { my $media_type = $pack->create( 'MediaType' => 'application/xml;charset=UTF-8' ); isa_ok($media_type, 'HTTP::Headers::ActionPack::MediaType'); is($media_type->as_string, 'application/xml; charset="UTF-8"', '... got the right string'); my $links = $pack->create_header( 'Link' => '; tag="child", ; tag="child", ; rel="up"'); isa_ok($links, 'HTTP::Headers::ActionPack::LinkList'); is($links->as_string, '; tag="child", ; tag="child", ; rel="up"', '... got the right string'); } { my $media_type = $pack->create( 'MediaType' => [ 'application/xml', charset => 'UTF-8' ] ); isa_ok($media_type, 'HTTP::Headers::ActionPack::MediaType'); is($media_type->as_string, 'application/xml; charset="UTF-8"', '... got the right string'); my $links = $pack->create_header( 'Link' => [ $pack->create( 'LinkHeader' => [ '', tag => "child" ] ), $pack->create( 'LinkHeader' => [ '', tag => "child" ] ), $pack->create( 'LinkHeader' => [ '', rel => "up" ] ), ]); isa_ok($links, 'HTTP::Headers::ActionPack::LinkList'); is($links->as_string, '; tag="child", ; tag="child", ; rel="up"', '... got the right string'); } done_testing;HTTP-Headers-ActionPack-0.09/t/071-basic-authorization.t0000644000175000017500000000210512160126437022360 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { use_ok('HTTP::Headers::ActionPack::Authorization::Basic'); } sub test_auth { my $auth = shift; is($auth->auth_type, 'Basic', '... got the right auth type'); is($auth->username, 'Aladdin', '... got the expected username'); is($auth->password, 'open sesame', '... got the expected password'); is($auth->as_string, 'Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==', '... got the right stringification') } test_auth( HTTP::Headers::ActionPack::Authorization::Basic->new_from_string( 'Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==' ) ); test_auth( HTTP::Headers::ActionPack::Authorization::Basic->new( 'Basic' => { username => 'Aladdin', password => 'open sesame' } ) ); test_auth( HTTP::Headers::ActionPack::Authorization::Basic->new( 'Basic' => [ 'Aladdin', 'open sesame' ] ) ); test_auth( HTTP::Headers::ActionPack::Authorization::Basic->new( 'Basic' => 'QWxhZGRpbjpvcGVuIHNlc2FtZQ==' ) ); done_testing;HTTP-Headers-ActionPack-0.09/t/040-link.t0000644000175000017500000000774612160126437017352 0ustar autarchautarch #!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { use_ok('HTTP::Headers::ActionPack::LinkHeader'); } =pod Examples taken from http://tools.ietf.org/html/rfc5988 =cut sub test_link { my $link = shift; isa_ok($link, 'HTTP::Headers::ActionPack::LinkHeader'); is($link->href, 'http://example.com/TheBook/chapter2', '... got the link we expected'); is($link->rel, 'previous', '... got the relation we expected'); is_deeply( $link->params, { rel => 'previous', title => 'previous chapter' }, '... got the parameters we expected' ); ok($link->relation_matches('previous'), '... relation matching works'); ok($link->relation_matches('Previous'), '... relation matching works'); ok($link->relation_matches('PREVIOUS'), '... relation matching works'); is( $link->as_string, '; rel="previous"; title="previous chapter"', '... got the string we expected' ); } test_link( HTTP::Headers::ActionPack::LinkHeader->new_from_string( ';rel="previous";title="previous chapter"' ) ); test_link( HTTP::Headers::ActionPack::LinkHeader->new( '' => ( rel => "previous", title => "previous chapter" ) ) ); test_link( HTTP::Headers::ActionPack::LinkHeader->new( 'http://example.com/TheBook/chapter2' => ( rel => "previous", title => "previous chapter" ) ) ); { my $link = HTTP::Headers::ActionPack::LinkHeader->new_from_string( '; rel="http://example.net/foo"' ); isa_ok($link, 'HTTP::Headers::ActionPack::LinkHeader'); is($link->href, '/', '... got the link we expected'); is($link->rel, 'http://example.net/foo', '... got the relation we expected'); is_deeply( $link->params, { rel => 'http://example.net/foo' }, '... got the parameters we expected' ); ok($link->relation_matches('http://example.net/foo'), '... relation matching works'); ok(!$link->relation_matches('HTTP://example.net/foo'), '... relation matching works'); is( $link->as_string, '; rel="http://example.net/foo"', '... got the string we expected' ); } { my $link = HTTP::Headers::ActionPack::LinkHeader->new_from_string( q{; rel="previous"; title*="UTF-8'de'letztes%20Kapitel"} ); isa_ok($link, 'HTTP::Headers::ActionPack::LinkHeader'); is($link->href, '/TheBook/chapter2', '... got the link we expected'); is($link->rel, 'previous', '... got the relation we expected'); is_deeply( $link->params, { 'rel' => 'previous', 'title*' => { encoding => 'UTF-8', language => 'de', content => 'letztes Kapitel' } }, '... got the parameters we expected' ); is( $link->as_string, q{; rel="previous"; title*="UTF-8'de'letztes%20Kapitel"}, '... got the string we expected' ); } { my $link = HTTP::Headers::ActionPack::LinkHeader->new_from_string( q{; rel="next"; title*=UTF-8'de'n%c3%a4chstes%20Kapitel} ); isa_ok($link, 'HTTP::Headers::ActionPack::LinkHeader'); is($link->href, '/TheBook/chapter4', '... got the link we expected'); is($link->rel, 'next', '... got the relation we expected'); is_deeply( $link->params, { 'rel' => 'next', 'title*' => { encoding => 'UTF-8', language => 'de', content => 'nächstes Kapitel' } }, '... got the parameters we expected' ); is( $link->as_string, q{; rel="next"; title*="UTF-8'de'n%C3%A4chstes%20Kapitel"}, '... got the string we expected' ); } done_testing;HTTP-Headers-ActionPack-0.09/t/release-pod-syntax.t0000644000175000017500000000045012160126437021621 0ustar autarchautarch#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::More; eval "use Test::Pod 1.41"; plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; all_pod_files_ok(); HTTP-Headers-ActionPack-0.09/t/000-load.t0000644000175000017500000000140112160126437017306 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More 0.88; use Test::Fatal 0.0003; BEGIN { use_ok('HTTP::Headers::ActionPack'); use_ok('HTTP::Headers::ActionPack::AuthenticationInfo'); use_ok('HTTP::Headers::ActionPack::Authorization::Basic'); use_ok('HTTP::Headers::ActionPack::Authorization::Digest'); use_ok('HTTP::Headers::ActionPack::DateHeader'); use_ok('HTTP::Headers::ActionPack::LinkHeader'); use_ok('HTTP::Headers::ActionPack::LinkList'); use_ok('HTTP::Headers::ActionPack::MediaType'); use_ok('HTTP::Headers::ActionPack::MediaTypeList'); use_ok('HTTP::Headers::ActionPack::PriorityList'); use_ok('HTTP::Headers::ActionPack::Util'); use_ok('HTTP::Headers::ActionPack::WWWAuthenticate'); } done_testing; HTTP-Headers-ActionPack-0.09/t/003-create-header-auth.t0000644000175000017500000000663012160126437022033 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { use_ok('HTTP::Headers::ActionPack'); } my $pack = HTTP::Headers::ActionPack->new; isa_ok($pack, 'HTTP::Headers::ActionPack'); sub test_basic_auth { my $auth = shift; isa_ok($auth, 'HTTP::Headers::ActionPack::Authorization::Basic'); is($auth->auth_type, 'Basic', '... got the right auth type'); is($auth->username, 'Aladdin', '... got the expected username'); is($auth->password, 'open sesame', '... got the expected password'); is($auth->as_string, 'Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==', '... got the right stringification') } sub test_digest_auth { my $auth = shift; isa_ok($auth, 'HTTP::Headers::ActionPack::Authorization::Digest'); is($auth->auth_type, 'Digest', '... got the right auth type'); is($auth->username, 'jon.dough@mobile.biz', '... got the right username'); is($auth->realm, 'RoamingUsers@mobile.biz', '... got the right realm'); is_deeply( $auth->params, { username => 'jon.dough@mobile.biz', realm => 'RoamingUsers@mobile.biz', nonce => "CjPk9mRqNuT25eRkajM09uTl9nM09uTl9nMz5OX25PZz==", uri => "sip:home.mobile.biz", qop => 'auth-int', nc => '00000001', cnonce => "0a4f113b", response => "6629fae49393a05397450978507c4ef1", opaque => "5ccc069c403ebaf9f0171e9517f40e41" }, '... got the right params list' ); is( $auth->as_string, q{Digest username="jon.dough@mobile.biz", realm="RoamingUsers@mobile.biz", nonce="CjPk9mRqNuT25eRkajM09uTl9nM09uTl9nMz5OX25PZz==", uri="sip:home.mobile.biz", qop="auth-int", nc="00000001", cnonce="0a4f113b", response="6629fae49393a05397450978507c4ef1", opaque="5ccc069c403ebaf9f0171e9517f40e41"}, '... got the right stringification' ); } test_basic_auth( $pack->create_header( 'Authorization' => 'Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==' ) ); test_basic_auth( $pack->create( 'Authorization' => [ 'Basic' => { username => 'Aladdin', password => 'open sesame' } ]) ); test_basic_auth( $pack->create_header( 'Authorization' => [ 'Basic' => [ 'Aladdin', 'open sesame' ] ]) ); test_basic_auth( $pack->create( 'Authorization' => [ 'Basic' => 'QWxhZGRpbjpvcGVuIHNlc2FtZQ==' ]) ); test_digest_auth( $pack->create_header( 'Authorization' => q{Digest username="jon.dough@mobile.biz", realm="RoamingUsers@mobile.biz", nonce="CjPk9mRqNuT25eRkajM09uTl9nM09uTl9nMz5OX25PZz==", uri="sip:home.mobile.biz", qop=auth-int, nc=00000001, cnonce="0a4f113b", response="6629fae49393a05397450978507c4ef1", opaque="5ccc069c403ebaf9f0171e9517f40e41"} ) ); test_digest_auth( $pack->create( 'Authorization' => [ 'Digest' => ( username => 'jon.dough@mobile.biz', realm => 'RoamingUsers@mobile.biz', nonce => "CjPk9mRqNuT25eRkajM09uTl9nM09uTl9nMz5OX25PZz==", uri => "sip:home.mobile.biz", qop => 'auth-int', nc => '00000001', cnonce => "0a4f113b", response => "6629fae49393a05397450978507c4ef1", opaque => "5ccc069c403ebaf9f0171e9517f40e41" ) ]) ); done_testing;HTTP-Headers-ActionPack-0.09/t/301-content-negotiation-language.t0000644000175000017500000000354712160126437024161 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { use_ok('HTTP::Headers::ActionPack'); } my $n = HTTP::Headers::ActionPack->new->get_content_negotiator; isa_ok($n, 'HTTP::Headers::ActionPack::ContentNegotiation'); # From http://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html is( $n->choose_language( ['da', 'en-US', 'es'], "da, en-gb;q=0.8, en;q=0.7" ), 'da', '... got the right language back' ); is( $n->choose_language( ['en-US', 'es'], "da, en-gb;q=0.8, en;q=0.7" ), 'en-US', '... got the right language back' ); is( $n->choose_language( ['en-gb', 'da'], "da, en-gb;q=0.8, en;q=0.7" ), 'da', '... got the right language back' ); is( $n->choose_language( ['en-US', 'en-GB'], "da, en-gb;q=0.8, en;q=0.7" ), 'en-GB', '... got the right language back' ); is( $n->choose_language( ['en-us'], "da, en-US;q=0.8, en;q=0.7" ), 'en-us', '... languages in choices list are canonicalized' ); is( $n->choose_language( ['en-US'], "da, en-us;q=0.8, en;q=0.7" ), 'en-US', '... languages in header are canonicalized' ); # From webmachine-ruby is($n->choose_language( [], 'en' ), undef, '... got nothing back'); is($n->choose_language( ['en'], 'es' ), undef, '... got nothing back'); is( $n->choose_language( ['en', 'en-US', 'es'], "en-US, es" ), 'en-US', '... got the right language back' ); is( $n->choose_language( ['en', 'en-US', 'es'], "en-US;q=0.6, es" ), 'es', '... got the right language back' ); is( $n->choose_language( ['en', 'fr', 'es'], "*" ), 'en', '... got the right language back' ); is( $n->choose_language( ['en-US', 'es'], "en, fr" ), 'en-US', '... got the right language back' ); is( $n->choose_language( [ 'en-US', 'ZH' ], "zh-ch, EN" ), 'en-US', '... got the right language back' ); done_testing; HTTP-Headers-ActionPack-0.09/t/100-http-headers.t0000644000175000017500000000306112160126437020764 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use HTTP::Headers; BEGIN { use_ok('HTTP::Headers::ActionPack::DateHeader'); use_ok('HTTP::Headers::ActionPack::LinkHeader'); use_ok('HTTP::Headers::ActionPack::LinkList'); use_ok('HTTP::Headers::ActionPack::MediaType'); } =pod This just tests that HTTP::Headers does not stringify our objects until we ask it to. =cut { my $h = HTTP::Headers->new( Date => HTTP::Headers::ActionPack::DateHeader->new_from_string('Mon, 23 Apr 2012 14:14:19 GMT'), Content_Type => HTTP::Headers::ActionPack::MediaType->new('application/xml', 'charset' => 'UTF-8'), Link => HTTP::Headers::ActionPack::LinkList->new( HTTP::Headers::ActionPack::LinkHeader->new( 'http://example.com/TheBook/chapter2' => ( rel => "previous", title => "previous chapter" ) ) ) ); isa_ok($h->header('Date'), 'HTTP::Headers::ActionPack::DateHeader', '... object is preserved and'); isa_ok($h->header('Content-Type'), 'HTTP::Headers::ActionPack::MediaType', '... object is preserved and'); isa_ok($h->header('Link'), 'HTTP::Headers::ActionPack::LinkList', '... object is preserved and'); is( $h->as_string, q{Date: Mon, 23 Apr 2012 14:14:19 GMT Content-Type: application/xml; charset="UTF-8" Link: ; rel="previous"; title="previous chapter" }, '... got the stringified headers' ); } done_testing;HTTP-Headers-ActionPack-0.09/t/101-http-request.t0000644000175000017500000000564112160126437021050 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use HTTP::Request; use HTTP::Headers; BEGIN { use_ok('HTTP::Headers::ActionPack::DateHeader'); use_ok('HTTP::Headers::ActionPack::LinkHeader'); use_ok('HTTP::Headers::ActionPack::LinkList'); use_ok('HTTP::Headers::ActionPack::MediaType'); } =pod This just tests that HTTP::Request does not stringify our objects until we ask it to. =cut { my $r = HTTP::Request->new( 'GET', '/foo', HTTP::Headers->new( Date => HTTP::Headers::ActionPack::DateHeader->new_from_string('Mon, 23 Apr 2012 14:14:19 GMT'), Content_Type => HTTP::Headers::ActionPack::MediaType->new('application/xml', 'charset' => 'UTF-8'), Link => HTTP::Headers::ActionPack::LinkList->new( HTTP::Headers::ActionPack::LinkHeader->new( 'http://example.com/TheBook/chapter2' => ( rel => "previous", title => "previous chapter" ) ) ) ) ); isa_ok($r->header('Date'), 'HTTP::Headers::ActionPack::DateHeader', '... object is preserved and'); isa_ok($r->header('Content-Type'), 'HTTP::Headers::ActionPack::MediaType', '... object is preserved and'); isa_ok($r->header('Link'), 'HTTP::Headers::ActionPack::LinkList', '... object is preserved and'); is( $r->as_string, q{GET /foo Date: Mon, 23 Apr 2012 14:14:19 GMT Content-Type: application/xml; charset="UTF-8" Link: ; rel="previous"; title="previous chapter" }, '... got the stringified headers' ); } { my $r = HTTP::Request->new( 'GET', '/foo', [ Date => HTTP::Headers::ActionPack::DateHeader->new_from_string('Mon, 23 Apr 2012 14:14:19 GMT'), Content_Type => HTTP::Headers::ActionPack::MediaType->new('application/xml', 'charset' => 'UTF-8'), Link => HTTP::Headers::ActionPack::LinkList->new( HTTP::Headers::ActionPack::LinkHeader->new( 'http://example.com/TheBook/chapter2' => ( rel => "previous", title => "previous chapter" ) ) ) ] ); isa_ok($r->header('Date'), 'HTTP::Headers::ActionPack::DateHeader', '... object is preserved and'); isa_ok($r->header('Content-Type'), 'HTTP::Headers::ActionPack::MediaType', '... object is preserved and'); isa_ok($r->header('Link'), 'HTTP::Headers::ActionPack::LinkList', '... object is preserved and'); is( $r->as_string, q{GET /foo Date: Mon, 23 Apr 2012 14:14:19 GMT Content-Type: application/xml; charset="UTF-8" Link: ; rel="previous"; title="previous chapter" }, '... got the stringified headers' ); } done_testing;HTTP-Headers-ActionPack-0.09/t/302-content-negotiation-charset.t0000644000175000017500000000510212160126437024015 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { use_ok('HTTP::Headers::ActionPack'); } my $n = HTTP::Headers::ActionPack->new->get_content_negotiator; isa_ok( $n, 'HTTP::Headers::ActionPack::ContentNegotiation' ); is( $n->choose_charset( [], 'ISO-8859-1' ), undef, '... got nothing back when there are no choices' ); is( $n->choose_charset( [ "UTF-8", "US-ASCII" ], "US-ASCII, UTF-8" ), 'US-ASCII', '... first value in the header wins when priorities are equal' ); is( $n->choose_charset( [ "UTF-8", "US-ASCII" ], "US-ASCII;q=0.7, UTF-8" ), 'UTF-8', '... higher priority charset is chosen over lower' ); is( $n->choose_charset( [ "UTF-8", "US-ASCII", "ISO-8859-1" ], 'ISO-8859-2' ), 'ISO-8859-1', '... got ISO-8859-1 even when it is not explicitly asked for' ); is( $n->choose_charset( [ "UTF-8", "US-ASCII", "ISO-8859-1", "ISO-8859-2" ], 'ISO-8859-2' ), 'ISO-8859-2', '... charset explicitly listed in header is preferred over ISO-8859-1 default' ); is( $n->choose_charset( [ "UTF-8", "US-ASCII" ], 'ISO-8859-1' ), 'UTF-8', '... got default back when the default is in list of choices and default is ok' ); is( $n->choose_charset( [ "utf8", "US-ASCII" ], 'ISO-8859-1' ), 'utf8', '... got default back when the default is in list of choices but not an exact match and default is ok' ); is( $n->choose_charset( ["US-ASCII"], 'ISO-8859-1' ), undef, '... got nothing back when default is not in list of choices' ); is( $n->choose_charset( [ "UTF-8", "US-ASCII" ], 'ISO-8859-1, UTF-8;q=0.0' ), undef, '... if default is listed as priority 0.0 it is not returned' ); is( $n->choose_charset( [ "UTF-8", "US-ASCII" ], 'ISO-8859-1, UTF-8;q=0' ), undef, '... if default is listed as priority 0 it is not returned (0 == 0.0)' ); is( $n->choose_charset( [ "UTF-8", "US-ASCII" ], 'ISO-8859-1, *;q=0.0' ), undef, '... if * is listed as priority 0.0 then default is not returned' ); is( $n->choose_charset( [ "UTF-8", "US-ASCII" ], 'ISO-8859-1, *;q=0.5, UTF-8;q=0.0' ), 'US-ASCII', '... if * is listed as priority 0.5 but default is 0.0 then default is not returned, but * can match other choices' ); is( $n->choose_charset( [ "UTF-8", "US-ASCII" ], "iso-8859-1, utf8" ), 'UTF-8', '... charsets in header are canonicalized' ); is( $n->choose_charset( [ "utf8", "US-ASCII" ], "iso-8859-1, UTF-8" ), 'utf8', '... the match is returned as formatted in the list of choices, without canonicalization' ); done_testing; HTTP-Headers-ActionPack-0.09/t/release-pod-no404s.t0000644000175000017500000000076512160126437021333 0ustar autarchautarch#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use strict; use warnings; use Test::More; foreach my $env_skip ( qw( SKIP_POD_NO404S AUTOMATED_TESTING ) ){ plan skip_all => "\$ENV{$env_skip} is set, skipping" if $ENV{$env_skip}; } eval "use Test::Pod::No404s"; if ( $@ ) { plan skip_all => 'Test::Pod::No404s required for testing POD'; } else { all_pod_files_ok(); } HTTP-Headers-ActionPack-0.09/t/004-inflate.t0000644000175000017500000000602712160126437020026 0ustar autarchautarch#!/usr/bin/env perl use strict; use warnings; use Test::More; use HTTP::Request; use Module::Runtime 'use_module'; use HTTP::Headers::ActionPack; my $has_plack = eval { use_module('HTTP::Message::PSGI'); use_module('Plack::Request'); 1; }; my $has_web_request = eval { use_module('Web::Request'); 1; }; my $pack = HTTP::Headers::ActionPack->new; { my $h = HTTP::Headers->new( Date => 'Mon, 23 Apr 2012 14:14:19 GMT', Content_Type => 'application/xml; charset=UTF-8', Link => '; rel=previous; title="previous chapter"' ); { my $r = HTTP::Request->new('GET', '/foo', $h->clone); $pack->inflate($r); my $date = $r->headers->header('date'); isa_ok($date, 'HTTP::Headers::ActionPack::DateHeader'); is($date->as_string, 'Mon, 23 Apr 2012 14:14:19 GMT'); my $content_type = $r->headers->header('content-type'); isa_ok($content_type, 'HTTP::Headers::ActionPack::MediaType'); like($content_type->as_string, qr{application/xml.*UTF-8}); my $link = $r->headers->header('link'); isa_ok($link, 'HTTP::Headers::ActionPack::LinkList'); like($link->as_string, qr{http://example\.com/TheBook/chapter2.*previous.*previous chapter}); } SKIP: { skip "Plack::Request and HTTP::Message::PSGI are required", 6 unless $has_plack; my $http_request = HTTP::Request->new('GET', '/foo', $h->clone); my $r = Plack::Request->new($http_request->to_psgi); $pack->inflate($r); my $date = $r->headers->header('date'); isa_ok($date, 'HTTP::Headers::ActionPack::DateHeader'); is($date->as_string, 'Mon, 23 Apr 2012 14:14:19 GMT'); my $content_type = $r->headers->header('content-type'); isa_ok($content_type, 'HTTP::Headers::ActionPack::MediaType'); like($content_type->as_string, qr{application/xml.*UTF-8}); my $link = $r->headers->header('link'); isa_ok($link, 'HTTP::Headers::ActionPack::LinkList'); like($link->as_string, qr{http://example\.com/TheBook/chapter2.*previous.*previous chapter}); } SKIP: { skip "Web::Request is required", 6 unless $has_plack && $has_web_request; my $http_request = HTTP::Request->new('GET', '/foo', $h->clone); my $r = Web::Request->new_from_env($http_request->to_psgi); $pack->inflate($r); my $date = $r->headers->header('date'); isa_ok($date, 'HTTP::Headers::ActionPack::DateHeader'); is($date->as_string, 'Mon, 23 Apr 2012 14:14:19 GMT'); my $content_type = $r->headers->header('content-type'); isa_ok($content_type, 'HTTP::Headers::ActionPack::MediaType'); like($content_type->as_string, qr{application/xml.*UTF-8}); my $link = $r->headers->header('link'); isa_ok($link, 'HTTP::Headers::ActionPack::LinkList'); like($link->as_string, qr{http://example\.com/TheBook/chapter2.*previous.*previous chapter}); } } done_testing; HTTP-Headers-ActionPack-0.09/t/303-content-negotiation-encoding.t0000644000175000017500000000153412160126437024160 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { use_ok('HTTP::Headers::ActionPack'); } my $n = HTTP::Headers::ActionPack->new->get_content_negotiator; isa_ok($n, 'HTTP::Headers::ActionPack::ContentNegotiation'); is($n->choose_encoding( [], 'identity, gzip' ), undef, '... got nothing back (encoding short circuited)'); is($n->choose_encoding( [ "gzip" ], 'identity' ), undef, '... got nothing back (encoding short circuited)'); is( $n->choose_encoding( [ "gzip", "identity" ], "identity" ), 'identity', '... got the right encoding back' ); is( $n->choose_encoding( [ "gzip" ], "identity, gzip" ), 'gzip', '... got the right encoding back' ); is( $n->choose_encoding( [ "gzip", "identity" ], "gzip, identity;q=0.7" ), 'gzip', '... got the right encoding back' ); done_testing;HTTP-Headers-ActionPack-0.09/t/070-authorization.t0000644000175000017500000000664012160126437021310 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { use_ok('HTTP::Headers::ActionPack::Authorization'); } sub test_basic_auth { my $auth = shift; isa_ok($auth, 'HTTP::Headers::ActionPack::Authorization::Basic'); is($auth->auth_type, 'Basic', '... got the right auth type'); is($auth->username, 'Aladdin', '... got the expected username'); is($auth->password, 'open sesame', '... got the expected password'); is($auth->as_string, 'Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==', '... got the right stringification') } sub test_digest_auth { my $auth = shift; isa_ok($auth, 'HTTP::Headers::ActionPack::Authorization::Digest'); is($auth->auth_type, 'Digest', '... got the right auth type'); is($auth->username, 'jon.dough@mobile.biz', '... got the right username'); is($auth->realm, 'RoamingUsers@mobile.biz', '... got the right realm'); is_deeply( $auth->params, { username => 'jon.dough@mobile.biz', realm => 'RoamingUsers@mobile.biz', nonce => "CjPk9mRqNuT25eRkajM09uTl9nM09uTl9nMz5OX25PZz==", uri => "sip:home.mobile.biz", qop => 'auth-int', nc => '00000001', cnonce => "0a4f113b", response => "6629fae49393a05397450978507c4ef1", opaque => "5ccc069c403ebaf9f0171e9517f40e41" }, '... got the right params list' ); is( $auth->as_string, q{Digest username="jon.dough@mobile.biz", realm="RoamingUsers@mobile.biz", nonce="CjPk9mRqNuT25eRkajM09uTl9nM09uTl9nMz5OX25PZz==", uri="sip:home.mobile.biz", qop="auth-int", nc="00000001", cnonce="0a4f113b", response="6629fae49393a05397450978507c4ef1", opaque="5ccc069c403ebaf9f0171e9517f40e41"}, '... got the right stringification' ); } test_basic_auth( HTTP::Headers::ActionPack::Authorization->new_from_string( 'Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==' ) ); test_basic_auth( HTTP::Headers::ActionPack::Authorization->new( 'Basic' => { username => 'Aladdin', password => 'open sesame' } ) ); test_basic_auth( HTTP::Headers::ActionPack::Authorization->new( 'Basic' => [ 'Aladdin', 'open sesame' ] ) ); test_basic_auth( HTTP::Headers::ActionPack::Authorization->new( 'Basic' => 'QWxhZGRpbjpvcGVuIHNlc2FtZQ==' ) ); test_digest_auth( HTTP::Headers::ActionPack::Authorization->new_from_string( q{Digest username="jon.dough@mobile.biz", realm="RoamingUsers@mobile.biz", nonce="CjPk9mRqNuT25eRkajM09uTl9nM09uTl9nMz5OX25PZz==", uri="sip:home.mobile.biz", qop=auth-int, nc=00000001, cnonce="0a4f113b", response="6629fae49393a05397450978507c4ef1", opaque="5ccc069c403ebaf9f0171e9517f40e41"} ) ); test_digest_auth( HTTP::Headers::ActionPack::Authorization->new( 'Digest' => ( username => 'jon.dough@mobile.biz', realm => 'RoamingUsers@mobile.biz', nonce => "CjPk9mRqNuT25eRkajM09uTl9nM09uTl9nMz5OX25PZz==", uri => "sip:home.mobile.biz", qop => 'auth-int', nc => '00000001', cnonce => "0a4f113b", response => "6629fae49393a05397450978507c4ef1", opaque => "5ccc069c403ebaf9f0171e9517f40e41" ) ) ); done_testing;HTTP-Headers-ActionPack-0.09/t/020-priority-list.t0000644000175000017500000000463212160126437021234 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { use_ok('HTTP::Headers::ActionPack::PriorityList'); } sub test_priority_list { my $q = shift; isa_ok($q, 'HTTP::Headers::ActionPack::PriorityList'); is_deeply($q->get(2.5), ["gorch"], '... got the right item for the priority'); is($q->priority_of("foo"), 1.0, '... got the right priority for the item'); is_deeply($q->get(3.0), ["baz", "foobaz"], '... got the right item for the priority'); is_deeply( [ $q->iterable ], [ [ 3, 'baz' ], [ 3, 'foobaz' ], [ 2.5, 'gorch' ], [ 2, 'bar' ], [ 1, 'foo' ] ], '... got the iterable form' ); is( $q->as_string, 'baz; q="3", foobaz; q="3", gorch; q="2.5", bar; q="2", foo; q="1"', '... got the right string form' ); } test_priority_list( HTTP::Headers::ActionPack::PriorityList->new( [ 1.0, "foo" ], [ 2.0, "bar" ], [ 3.0, "baz" ], [ 3.0, "foobaz" ], [ 2.5, "gorch" ], ) ); test_priority_list( HTTP::Headers::ActionPack::PriorityList->new_from_string( 'foo; q="1.0", bar; q="2.0", baz; q="3.0", foobaz; q="3.0", gorch; q="2.5"' ) ); { my $q = HTTP::Headers::ActionPack::PriorityList->new; $q->add( 1.0, "foo" ); $q->add( 2.0, "bar" ); $q->add( 3.0, "baz" ); $q->add( 3.0, "foobaz" ); $q->add( 2.5, "gorch" ); test_priority_list( $q ); } { my $q = HTTP::Headers::ActionPack::PriorityList->new_from_string( "application/xml;q=0.7" ); is_deeply($q->get(0.7), ["application/xml"], '... got the right item for the priority'); is($q->priority_of("application/xml"), 0.7, '... got the right priority for the item'); is_deeply( [ $q->iterable ], [ [ 0.7, "application/xml" ], ], '... got the iterable form' ); is( $q->as_string, 'application/xml; q="0.7"', '... got the right string form' ); } { my $q = HTTP::Headers::ActionPack::PriorityList->new_from_string( "foo, bar" ); is_deeply( [ $q->iterable ], [ [ 1, "foo" ], [ 1, "bar" ], ], '... got the iterable form' ); is( $q->as_string, 'foo; q="1", bar; q="1"', '... got the right string form' ); } done_testing; HTTP-Headers-ActionPack-0.09/t/200-plack.t0000644000175000017500000001166312160126437017476 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use HTTP::Request; use HTTP::Response; use HTTP::Headers; use Module::Runtime qw[ use_module ]; =pod This just tests that HTTP::Message::PSGI, Plack::Request and Plack::Response do not stringify our objects. =cut BEGIN { unless ( eval { use_module('HTTP::Message::PSGI') && use_module('Plack::Request') && use_module('Plack::Response') } ) { plan skip_all => "Must have HTTP::Message::PSGI, Plack::Request and Plack::Response"; } } BEGIN { use_ok('HTTP::Headers::ActionPack'); use_ok('HTTP::Headers::ActionPack::DateHeader'); use_ok('HTTP::Headers::ActionPack::LinkHeader'); use_ok('HTTP::Headers::ActionPack::LinkList'); use_ok('HTTP::Headers::ActionPack::MediaType'); } { my $r = HTTP::Request->new( 'GET', '/foo', [ Date => HTTP::Headers::ActionPack::DateHeader->new_from_string('Mon, 23 Apr 2012 14:14:19 GMT'), Content_Type => HTTP::Headers::ActionPack::MediaType->new('application/xml', 'charset' => 'UTF-8'), Link => HTTP::Headers::ActionPack::LinkList->new( HTTP::Headers::ActionPack::LinkHeader->new( 'http://example.com/TheBook/chapter2' => ( rel => "previous", title => "previous chapter" ) ) ) ] ); my $env = $r->to_psgi; isa_ok($env->{'HTTP_DATE'}, 'HTTP::Headers::ActionPack::DateHeader', '... object is preserved and'); isa_ok($env->{'CONTENT_TYPE'}, 'HTTP::Headers::ActionPack::MediaType', '... object is preserved and'); isa_ok($env->{'HTTP_LINK'}, 'HTTP::Headers::ActionPack::LinkList', '... object is preserved and'); my $plack_r = Plack::Request->new( $env ); isa_ok($plack_r->header('Date'), 'HTTP::Headers::ActionPack::DateHeader', '... object is preserved and'); isa_ok($plack_r->header('Content-Type'), 'HTTP::Headers::ActionPack::MediaType', '... object is preserved and'); isa_ok($plack_r->header('Link'), 'HTTP::Headers::ActionPack::LinkList', '... object is preserved and'); } { my $r = [ 200, [ Date => HTTP::Headers::ActionPack::DateHeader->new_from_string('Mon, 23 Apr 2012 14:14:19 GMT'), Content_Type => HTTP::Headers::ActionPack::MediaType->new('application/xml', 'charset' => 'UTF-8'), Link => HTTP::Headers::ActionPack::LinkList->new( HTTP::Headers::ActionPack::LinkHeader->new( 'http://example.com/TheBook/chapter2' => ( rel => "previous", title => "previous chapter" ) ) ) ], [] ]; my $http_r = HTTP::Response->from_psgi( $r ); isa_ok($http_r->header('Date'), 'HTTP::Headers::ActionPack::DateHeader', '... object is preserved and'); isa_ok($http_r->header('Content-Type'), 'HTTP::Headers::ActionPack::MediaType', '... object is preserved and'); isa_ok($http_r->header('Link'), 'HTTP::Headers::ActionPack::LinkList', '... object is preserved and'); is( $http_r->as_string, q{200 OK Date: Mon, 23 Apr 2012 14:14:19 GMT Content-Type: application/xml; charset="UTF-8" Link: ; rel="previous"; title="previous chapter" }, '... got the stringified headers' ); my $plack_r = Plack::Response->new( @$r ); isa_ok($plack_r->header('Date'), 'HTTP::Headers::ActionPack::DateHeader', '... object is preserved and'); isa_ok($plack_r->header('Content-Type'), 'HTTP::Headers::ActionPack::MediaType', '... object is preserved and'); isa_ok($plack_r->header('Link'), 'HTTP::Headers::ActionPack::LinkList', '... object is preserved and'); } { my $r = HTTP::Request->new( 'GET', '/foo', [ Date => 'Mon, 23 Apr 2012 14:14:19 GMT', Content_Type => 'application/xml; charset=UTF-8', Link => '; rel=previous; title="previous chapter"' ] ); my $plack_r = Plack::Request->new( $r->to_psgi ); HTTP::Headers::ActionPack->new->inflate( $plack_r ); isa_ok($plack_r->header('Date'), 'HTTP::Headers::ActionPack::DateHeader', '... object is inflated and'); isa_ok($plack_r->header('Content-Type'), 'HTTP::Headers::ActionPack::MediaType', '... object is inflated and'); isa_ok($plack_r->header('Link'), 'HTTP::Headers::ActionPack::LinkList', '... object is inflated and'); is($plack_r->env->{'HTTP_DATE'}, 'Mon, 23 Apr 2012 14:14:19 GMT', '... the underlying env is preserved'); is($plack_r->env->{'CONTENT_TYPE'}, 'application/xml; charset=UTF-8', '... the underlying env is preserved'); is($plack_r->env->{'HTTP_LINK'}, '; rel=previous; title="previous chapter"', '... the underlying env is preserved'); } done_testing; HTTP-Headers-ActionPack-0.09/t/400-undef-warnings.t0000644000175000017500000000151412160126437021327 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::Fatal; use Test::More; use Test::Warnings; use HTTP::Headers::ActionPack; use HTTP::Headers::ActionPack::AuthenticationInfo; { my $auth = HTTP::Headers::ActionPack::AuthenticationInfo->new( foo => 42, bar => undef, ); isa_ok( $auth, 'HTTP::Headers::ActionPack::AuthenticationInfo', 'object from constructor' ); is( $auth->as_string, q{foo="42", bar=""}, 'auth header as string' ); } { my $auth = HTTP::Headers::ActionPack->new->create_header( 'Authentication-Info', q{foo="42", bar=}, ); isa_ok( $auth, 'HTTP::Headers::ActionPack::AuthenticationInfo', 'object from $pack->create_header' ); is( $auth->as_string, q{foo="42", bar=""}, 'auth header as string' ); } done_testing(); HTTP-Headers-ActionPack-0.09/t/002-http-headers-inflate.t0000644000175000017500000000323212160126437022405 0ustar autarchautarch#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use HTTP::Headers; BEGIN { use_ok('HTTP::Headers::ActionPack'); } my $pack = HTTP::Headers::ActionPack->new; isa_ok($pack, 'HTTP::Headers::ActionPack'); { my $h = HTTP::Headers->new( Date => 'Mon, 23 Apr 2012 14:14:19 GMT', Content_Type => 'application/xml; charset=UTF-8', Link => '; rel=previous; title="previous chapter"' ); $pack->inflate( $h ); isa_ok($h->header('Date'), 'HTTP::Headers::ActionPack::DateHeader', '... object is preserved and'); isa_ok($h->header('Content-Type'), 'HTTP::Headers::ActionPack::MediaType', '... object is preserved and'); isa_ok($h->header('Link'), 'HTTP::Headers::ActionPack::LinkList', '... object is preserved and'); is( $h->as_string, q{Date: Mon, 23 Apr 2012 14:14:19 GMT Content-Type: application/xml; charset="UTF-8" Link: ; rel="previous"; title="previous chapter" }, '... got the stringified headers' ); } { my $h = HTTP::Headers->new( "link" => ';' . ' riaktag=\"contained\",' . ';' . ' riaktag=\"contained\",' . ';' . ' riaktag=\"contained\"', ); $pack->inflate( $h ); is(exception { $pack->inflate( $h ) }, undef, '... this does not throw an exception'); } done_testing; HTTP-Headers-ActionPack-0.09/lib/0000775000175000017500000000000012160126437016216 5ustar autarchautarchHTTP-Headers-ActionPack-0.09/lib/HTTP/0000775000175000017500000000000012160126437016775 5ustar autarchautarchHTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/0000775000175000017500000000000012160126437020350 5ustar autarchautarchHTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack.pm0000644000175000017500000002460012160126437022722 0ustar autarchautarchpackage HTTP::Headers::ActionPack; BEGIN { $HTTP::Headers::ActionPack::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::VERSION = '0.09'; } # ABSTRACT: HTTP Action, Adventure and Excitement use strict; use warnings; use Scalar::Util qw[ blessed ]; use Carp qw[ confess ]; use Module::Runtime qw[ use_module ]; my @DEFAULT_CLASSES = qw[ HTTP::Headers::ActionPack::AcceptCharset HTTP::Headers::ActionPack::AcceptLanguage HTTP::Headers::ActionPack::AuthenticationInfo HTTP::Headers::ActionPack::Authorization HTTP::Headers::ActionPack::Authorization::Basic HTTP::Headers::ActionPack::Authorization::Digest HTTP::Headers::ActionPack::DateHeader HTTP::Headers::ActionPack::LinkHeader HTTP::Headers::ActionPack::LinkList HTTP::Headers::ActionPack::MediaType HTTP::Headers::ActionPack::MediaTypeList HTTP::Headers::ActionPack::PriorityList HTTP::Headers::ActionPack::WWWAuthenticate ]; my %DEFAULT_MAPPINGS = ( 'link' => 'HTTP::Headers::ActionPack::LinkList', 'content-type' => 'HTTP::Headers::ActionPack::MediaType', 'accept' => 'HTTP::Headers::ActionPack::MediaTypeList', 'accept-charset' => 'HTTP::Headers::ActionPack::AcceptCharset', 'accept-encoding' => 'HTTP::Headers::ActionPack::PriorityList', 'accept-language' => 'HTTP::Headers::ActionPack::AcceptLanguage', 'date' => 'HTTP::Headers::ActionPack::DateHeader', 'client-date' => 'HTTP::Headers::ActionPack::DateHeader', # added by LWP 'expires' => 'HTTP::Headers::ActionPack::DateHeader', 'last-modified' => 'HTTP::Headers::ActionPack::DateHeader', 'if-unmodified-since' => 'HTTP::Headers::ActionPack::DateHeader', 'if-modified-since' => 'HTTP::Headers::ActionPack::DateHeader', 'www-authenticate' => 'HTTP::Headers::ActionPack::WWWAuthenticate', 'authentication-info' => 'HTTP::Headers::ActionPack::AuthenticationInfo', 'authorization' => 'HTTP::Headers::ActionPack::Authorization', ); sub new { my $class = shift; my %additional = @_; my %mappings = ( %DEFAULT_MAPPINGS, %additional ); my %classes = map { $_ => undef } ( @DEFAULT_CLASSES, values %additional ); bless { mappings => \%mappings, classes => \%classes } => $class; } sub mappings { (shift)->{'mappings'} } sub classes { keys %{ (shift)->{'classes'} } } sub has_mapping { my ($self, $header_name) = @_; exists $self->{'mappings'}->{ lc $header_name } ? 1 : 0 } sub get_content_negotiator { use_module('HTTP::Headers::ActionPack::ContentNegotiation')->new( shift ); } sub create { my ($self, $class_name, $args) = @_; my $class = exists $self->{'classes'}->{ $class_name } ? $class_name : exists $self->{'classes'}->{ __PACKAGE__ . '::' . $class_name } ? __PACKAGE__ . '::' . $class_name : undef; (defined $class) || confess "Could not find class '$class_name' (or 'HTTP::Headers::ActionPack::$class_name')"; ref $args ? use_module( $class )->new( @$args ) : use_module( $class )->new_from_string( $args ); } sub create_header { my ($self, $header_name, $header_value) = @_; my $class = $self->{'mappings'}->{ lc $header_name }; (defined $class) || confess "Could not find mapping for '$header_name'"; ref $header_value ? use_module( $class )->new( @$header_value ) : use_module( $class )->new_from_string( $header_value ); } sub inflate { my $self = shift; return $self->_inflate_http_headers( @_ ) if $_[0]->isa('HTTP::Headers'); return $self->_inflate_generic_request( @_ ) if $_[0]->isa('HTTP::Request') || $_[0]->isa('Plack::Request') || $_[0]->isa('Web::Request'); confess "I don't know how to inflate '$_[0]'"; } sub _inflate_http_headers { my ($self, $http_headers) = @_; foreach my $header ( keys %{ $self->{'mappings'} } ) { if ( my $old = $http_headers->header( $header ) ) { $http_headers->header( $header => $self->create_header( $header, $old ) ) unless blessed $old && $old->isa('HTTP::Headers::ActionPack::Core::Base'); } } return $http_headers; } sub _inflate_generic_request { my ($self, $request) = @_; $self->_inflate_http_headers( $request->headers ); return $request; } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack - HTTP Action, Adventure and Excitement =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack; my $pack = HTTP::Headers::ActionPack->new; my $media_type = $pack->create_header( 'Content-Type' => 'application/xml;charset=UTF-8' ); my $link = $pack->create( 'LinkHeader' => [ '', rel => "up" ] ); # auto-magic header inflation # for multiple types $pack->inflate( $http_headers_instance ); $pack->inflate( $http_request_instance ); $pack->inflate( $plack_request_instance ); =head1 DESCRIPTION This is a module to handle the inflation and deflation of complex HTTP header types. In many cases header values are simple strings, but in some cases they are complex values with a lot of information encoded in them. The goal of this module is to make the parsing and analysis of these headers as easy as calling C on a compatible object (see below for a list). This top-level class is basically a Factory for creating instances of the other classes in this module. It contains a number of convenience methods to help make common cases easy to write. =head1 DEFAULT MAPPINGS This class provides a set of default mappings between HTTP headers and the classes which can inflate them. Here is the list of default mappings this class provides. Link HTTP::Headers::ActionPack::LinkList Content-Type HTTP::Headers::ActionPack::MediaType Accept HTTP::Headers::ActionPack::MediaTypeList Accept-Charset HTTP::Headers::ActionPack::PriorityList Accept-Encoding HTTP::Headers::ActionPack::PriorityList Accept-Language HTTP::Headers::ActionPack::PriorityList Date HTTP::Headers::ActionPack::DateHeader Client-Date HTTP::Headers::ActionPack::DateHeader Expires HTTP::Headers::ActionPack::DateHeader Last-Modified HTTP::Headers::ActionPack::DateHeader If-Unmodified-Since HTTP::Headers::ActionPack::DateHeader If-Modified-Since HTTP::Headers::ActionPack::DateHeader WWW-Authenticate HTTP::Headers::ActionPack::WWWAuthenticate Authentication-Info HTTP::Headers::ActionPack::AuthenticationInfo Authorization HTTP::Headers::ActionPack::Authorization NOTE: The 'Client-Date' header is often added by L on L objects. =head1 METHODS =over 4 =item C The constructor takes an option hash of header-name to class mappings to add too (or override) the default mappings (see above for details). Each class is expected to have a C method which can parse the string representation of the given header and return an object. =item C This returns the set of mappings in this instance. =item C This returns the list of supported classes, which is by default the list of classes included in this modules, but it also will grab any additionally classes that were specified in the C<%mappings> parameter to C (see above). =item C Returns an instance of L. =item C This method, given a C<$class_name> and C<$args>, will inflate the value using the class found in the C list. If C<$args> is a string it will call C on the C<$class_name>, but if C<$args> is an ARRAY ref, it will dereference the ARRAY and pass it to C. =item C This method, given a C<$header_name> and a C<$header_value> will inflate the value using the class found in the mappings. If C<$header_value> is a string it will call C on the class mapped to the C<$header_name>, but if C<$header_value> is an ARRAY ref, it will dereference the ARRAY and pass it to C. =item C =item C =item C =item C Given either a L instance, a L instance, a L instance, or a L instance, this method will inflate all the relevant headers and store the object in the same instance. In theory this should not negatively affect anything since all the header objects overload the stringification operator, and most often the headers are treated as strings. However, this is not for certain and care should be taken. =back =head1 CAVEATS =head2 Plack Compatibility We have a test in the suite that checks to make sure that any inflated header objects will pass between L and L objects as well as L and L objects. A simple survey of most of the L subclasses shows that most of them will end up properly stringifying these header objects before sending them out. The notable exceptions were the Apache handlers. At the time of this writing, the solution for this would be for you to either stringify these objects prior to returning your Plack::Response, or to write a simple middleware component that would do that for you. In future versions we might provide just such a middleware (it would likely inflate the header objects on the request side as well). =head2 Stringification As mentioned above, all the header objects overload the stringification operator, so normal usage of them should just do what you would expect (stringify in a sensible way). However this is not certain and so care should be taken when passing object headers onto another library that is expecting strings. =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/0000775000175000017500000000000012160126437022364 5ustar autarchautarchHTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/AcceptLanguage.pm0000644000175000017500000000446712160126437025576 0ustar autarchautarchpackage HTTP::Headers::ActionPack::AcceptLanguage; BEGIN { $HTTP::Headers::ActionPack::AcceptLanguage::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::AcceptLanguage::VERSION = '0.09'; } # ABSTRACT: A Priority List customized for Media Types use strict; use warnings; use parent 'HTTP::Headers::ActionPack::PriorityList'; # We'll just assume that any script or variant names are being given in the # right form. To do this all properly would basically require having all the # ICU data available, which we're not going to attempt currently. sub canonicalize_choice { return unless defined $_[1]; my @parts = split /[-_]/, $_[1]; my $lang = lc shift @parts; if (@parts) { $parts[-1] = uc $parts[-1] if length $parts[-1] == 2; } return join '-', $lang, @parts; } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::AcceptLanguage - A Priority List customized for Media Types =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack::AcceptLanguage; # normal constructor my $list = HTTP::Headers::ActionPack::AcceptLanguage->new( [ 1.0 => 'en-US' ], [ 0.7 => 'en-GB' ], ); # or from a string my $list = HTTP::Headers::ActionPack::AcceptLanguageList->new_from_string( 'en-US; q=1.0, en-GB; q=0.7' ); =head1 DESCRIPTION This is a subclass of the L class with some language specific features. =head1 METHODS =over 4 =item C This takes a string containing a locale code and returns the canonical version of that code. This is incomplete, as it simply lower cases the language piece ("en", "zh") and upper cases the country ("US", "TW"). It does not attempt to canonicalize scripts or variants in the locale code. =back =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/AuthenticationInfo.pm0000644000175000017500000000437112160126437026520 0ustar autarchautarchpackage HTTP::Headers::ActionPack::AuthenticationInfo; BEGIN { $HTTP::Headers::ActionPack::AuthenticationInfo::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::AuthenticationInfo::VERSION = '0.09'; } # ABSTRACT: The Authentication-Info Header use strict; use warnings; use HTTP::Headers::ActionPack::Util qw[ join_header_params ]; use parent 'HTTP::Headers::ActionPack::Core::BaseHeaderWithParams'; sub BUILDARGS { my $class = shift; $class->_prepare_params( @_ ) } sub new_from_string { my ($class, $header_string) = @_; $class->new( map { @$_ } HTTP::Headers::Util::_split_header_words( $header_string ) ); } sub as_string { join_header_params( ', ' => (shift)->params_in_order ); } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::AuthenticationInfo - The Authentication-Info Header =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack::AuthenticationInfo; # create from string my $auth_info = HTTP::Headers::ActionPack::AuthenticationInfo->new_from_string( 'qop=auth-int, rspauth="6629fae49393a05397450978507c4ef1", cnonce="0a4f113b", nc=00000001' ); # create from parameters my $auth_info = HTTP::Headers::ActionPack::AuthenticationInfo->new( qop => 'auth-int', rspauth => "6629fae49393a05397450978507c4ef1", cnonce => "0a4f113b", nc => '00000001' ); =head1 DESCRIPTION This class represents the Authentication-Info header, it is a pretty parameter based header and so inherits from L to handle all the parameters. =head1 METHODS =over 4 =item C =item C =item C =back =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/WWWAuthenticate.pm0000644000175000017500000000450012160126437025742 0ustar autarchautarchpackage HTTP::Headers::ActionPack::WWWAuthenticate; BEGIN { $HTTP::Headers::ActionPack::WWWAuthenticate::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::WWWAuthenticate::VERSION = '0.09'; } # ABSTRACT: The WWW-Authenticate Header use strict; use warnings; use parent 'HTTP::Headers::ActionPack::Core::BaseAuthHeader'; sub realm { (shift)->params->{'realm'} } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::WWWAuthenticate - The WWW-Authenticate Header =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack::WWWAuthenticate; # create from string my $www_authen = HTTP::Headers::ActionPack::WWWAuthenticate->new_from_string( 'Basic realm="WallyWorld"' ); # create using parameters my $www_authen = HTTP::Headers::ActionPack::WWWAuthenticate->new( 'Basic' => ( realm => 'WallyWorld' ) ); # create from string my $www_authen = HTTP::Headers::ActionPack::WWWAuthenticate->new_from_string( q{Digest realm="testrealm@host.com", qop="auth,auth-int", nonce="dcd98b7102dd2f0e8b11d0f600bfb0c093", opaque="5ccc069c403ebaf9f0171e9517f40e41"'} ); # create using parameters my $www_authen = HTTP::Headers::ActionPack::WWWAuthenticate->new( 'Digest' => ( realm => 'testrealm@host.com', qop => "auth,auth-int", nonce => "dcd98b7102dd2f0e8b11d0f600bfb0c093", opaque => "5ccc069c403ebaf9f0171e9517f40e41" ) ); =head1 DESCRIPTION This class represents the WWW-Authenticate header and all it's variations, it is based on the L class. =head1 METHODS =over 4 =item C =item C =item C =item C =back =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/Authorization/0000775000175000017500000000000012160126437025224 5ustar autarchautarchHTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/Authorization/Basic.pm0000644000175000017500000000672012160126437026606 0ustar autarchautarchpackage HTTP::Headers::ActionPack::Authorization::Basic; BEGIN { $HTTP::Headers::ActionPack::Authorization::Basic::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::Authorization::Basic::VERSION = '0.09'; } # ABSTRACT: The Basic Authorization Header use strict; use warnings; use Carp qw[ confess ]; use MIME::Base64 qw[ encode_base64 decode_base64 ]; use parent 'HTTP::Headers::ActionPack::Core::Base'; sub BUILDARGS { my $class = shift; my $type = shift || confess "Must specify type"; my $credentials = shift || confess "Must provide credentials"; if ( ref $credentials && ref $credentials eq 'HASH' ) { return +{ auth_type => $type, %$credentials }; } elsif ( ref $credentials && ref $credentials eq 'ARRAY' ) { my ($username, $password) = @$credentials; return +{ auth_type => $type, username => $username, password => $password }; } else { my ($username, $password) = split ':' => decode_base64( $credentials ); return +{ auth_type => $type, username => $username, password => $password }; } } sub new_from_string { my ($class, $header_string) = @_; my ($type, $credentials) = split /\s/ => $header_string; ($type eq 'Basic') || confess "The type must be 'Basic', not '$type'"; $class->new( $type, $credentials ); } sub auth_type { (shift)->{'auth_type'} } sub username { (shift)->{'username'} } sub password { (shift)->{'password'} } sub as_string { my $self = shift; join ' ' => $self->auth_type, encode_base64( (join ':' => $self->username, $self->password), '' ) } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::Authorization::Basic - The Basic Authorization Header =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack::Authorization::Basic; # create from string my $auth = HTTP::Headers::ActionPack::Authorization::Basic->new_from_string( 'Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==' ); # create from parameters my $auth = HTTP::Headers::ActionPack::Authorization::Basic->new( 'Basic' => { username => 'Aladdin', password => 'open sesame' } ); my $auth = HTTP::Headers::ActionPack::Authorization::Basic->new( 'Basic' => [ 'Aladdin', 'open sesame' ] ); my $auth = HTTP::Headers::ActionPack::Authorization::Basic->new( 'Basic' => 'QWxhZGRpbjpvcGVuIHNlc2FtZQ==' ); =head1 DESCRIPTION This class represents the Authorization header with the specific focus on the 'Basic' type. =head1 METHODS =over 4 =item C The C<$credentials> argument can either be a Base64 encoded string (as would be passed in via the header), a HASH ref with username and password keys, or a two element ARRAY ref where the first element is the username and the second the password. =item C =item C =item C =item C =item C =back =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/Authorization/Digest.pm0000644000175000017500000000506412160126437027004 0ustar autarchautarchpackage HTTP::Headers::ActionPack::Authorization::Digest; BEGIN { $HTTP::Headers::ActionPack::Authorization::Digest::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::Authorization::Digest::VERSION = '0.09'; } # ABSTRACT: The Digest Authorization Header use strict; use warnings; use parent 'HTTP::Headers::ActionPack::Core::BaseAuthHeader'; sub username { (shift)->params->{'username'} } sub realm { (shift)->params->{'realm'} } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::Authorization::Digest - The Digest Authorization Header =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack::Authorization::Digest; # create from string my $auth = HTTP::Headers::ActionPack::Authorization::Digest->new_from_string( q{Digest username="jon.dough@mobile.biz", realm="RoamingUsers@mobile.biz", nonce="CjPk9mRqNuT25eRkajM09uTl9nM09uTl9nMz5OX25PZz==", uri="sip:home.mobile.biz", qop=auth-int, nc=00000001, cnonce="0a4f113b", response="6629fae49393a05397450978507c4ef1", opaque="5ccc069c403ebaf9f0171e9517f40e41"} ); # create from parameters my $auth = HTTP::Headers::ActionPack::Authorization::Digest->new( 'Digest' => ( username => 'jon.dough@mobile.biz', realm => 'RoamingUsers@mobile.biz', nonce => "CjPk9mRqNuT25eRkajM09uTl9nM09uTl9nMz5OX25PZz==", uri => "sip:home.mobile.biz", qop => 'auth-int', nc => '00000001', cnonce => "0a4f113b", response => "6629fae49393a05397450978507c4ef1", opaque => "5ccc069c403ebaf9f0171e9517f40e41" ) ); =head1 DESCRIPTION This class represents the Authorization header with the specific focus on the 'Basic' type. It is just a simple subclass of L =head1 METHODS =over 4 =item C =item C =item C =item C =item C =back =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/Core/0000775000175000017500000000000012160126437023254 5ustar autarchautarchHTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/Core/BaseHeaderList.pm0000644000175000017500000000401112160126437026423 0ustar autarchautarchpackage HTTP::Headers::ActionPack::Core::BaseHeaderList; BEGIN { $HTTP::Headers::ActionPack::Core::BaseHeaderList::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::Core::BaseHeaderList::VERSION = '0.09'; } # ABSTRACT: A Base Header List use strict; use warnings; use Scalar::Util qw[ blessed ]; use HTTP::Headers::ActionPack::Util qw[ split_header_words ]; use parent 'HTTP::Headers::ActionPack::Core::Base'; sub new_from_string { my ($class, $header_string) = @_; my $list = $class->new; foreach my $header ( split_header_words( $header_string ) ) { $list->add_header_value( $header ) } $list; } sub as_string { my $self = shift; join ', ' => map { blessed $_ ? $_->as_string : $_ } $self->iterable; } sub add { die "Abstract method" } sub add_header_value { die "Abstract method" } sub iterable { die "Abstract method" } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::Core::BaseHeaderList - A Base Header List =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack::Core::BaseHeaderList; =head1 DESCRIPTION This is a base class for header lists. There are no real user serviceable parts in here. =head1 METHODS =over 4 =item C This accepts a HTTP header string which get parsed and loaded accordingly. =item C =back =head1 ABSTRACT METHODS =over 4 =item C =item C =item C =back =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/Core/Base.pm0000644000175000017500000000301512160126437024461 0ustar autarchautarchpackage HTTP::Headers::ActionPack::Core::Base; BEGIN { $HTTP::Headers::ActionPack::Core::Base::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::Core::Base::VERSION = '0.09'; } # ABSTRACT: A Base class use strict; use warnings; use overload '""' => 'as_string', fallback => 1; sub new { my $class = shift; my $self = $class->CREATE( $class->BUILDARGS( @_ ) ); $self->BUILD( @_ ); $self; } sub BUILDARGS { +{ ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ } } sub CREATE { my ($class, $instance) = @_; bless $instance => $class; } sub BUILD {} sub as_string { my $self = shift; "$self" } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::Core::Base - A Base class =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack::Core::Base; =head1 DESCRIPTION There are no real user serviceable parts in here. =head1 METHODS =over 4 =item C =item C =item C =item C =item C =back =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/Core/BaseAuthHeader.pm0000644000175000017500000000410312160126437026413 0ustar autarchautarchpackage HTTP::Headers::ActionPack::Core::BaseAuthHeader; BEGIN { $HTTP::Headers::ActionPack::Core::BaseAuthHeader::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::Core::BaseAuthHeader::VERSION = '0.09'; } # ABSTRACT: The base Auth Header use strict; use warnings; use Carp qw[ confess ]; use HTTP::Headers::ActionPack::Util qw[ join_header_params ]; use parent 'HTTP::Headers::ActionPack::Core::BaseHeaderWithParams'; sub BUILDARGS { my $class = shift; my ($type, @params) = @_; confess "You must specify an auth-type" unless $type; return +{ auth_type => $type, %{ $class->_prepare_params( @params ) } }; } sub new_from_string { my ($class, $header_string) = @_; my @parts = HTTP::Headers::Util::_split_header_words( $header_string ); splice @{ $parts[0] }, 1, 1; $class->new( map { @$_ } @parts ); } sub auth_type { (shift)->{'auth_type'} } sub as_string { my $self = shift; $self->auth_type . ' ' . join_header_params( ', ' => $self->params_in_order ); } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::Core::BaseAuthHeader - The base Auth Header =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack::Core::BaseAuthHeader; =head1 DESCRIPTION This is a base class for Auth-style headers; it inherits from L. =head1 METHODS =over 4 =item C =item C =item C =item C =back =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/Core/BaseHeaderType.pm0000644000175000017500000000436312160126437026443 0ustar autarchautarchpackage HTTP::Headers::ActionPack::Core::BaseHeaderType; BEGIN { $HTTP::Headers::ActionPack::Core::BaseHeaderType::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::Core::BaseHeaderType::VERSION = '0.09'; } # ABSTRACT: A Base header type use strict; use warnings; use Carp qw[ confess ]; use HTTP::Headers::ActionPack::Util qw[ split_header_words join_header_words ]; use parent 'HTTP::Headers::ActionPack::Core::BaseHeaderWithParams'; sub BUILDARGS { my $class = shift; my ($subject, @params) = @_; confess "You must specify a subject" unless $subject; return +{ subject => $subject, %{ $class->_prepare_params( @params ) } }; } sub subject { (shift)->{'subject'} } sub new_from_string { my ($class, $header_string) = @_; $class->new( @{ (split_header_words( $header_string ))[0] } ); } sub as_string { my $self = shift; join_header_words( $self->subject, $self->params_in_order ); } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::Core::BaseHeaderType - A Base header type =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack::Core::BaseHeaderType; =head1 DESCRIPTION This is a base class for header values which also contain a parameter list. There are no real user serviceable parts in here. =head1 METHODS =over 4 =item C =item C =item C This will take an HTTP header string and parse it into and object. =item C This stringifies the link respecting the parameter order. NOTE: This will canonicalize the header such that it will add a space between each semicolon and quotes and unquotes all headers appropriately. =back =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/Core/BaseHeaderWithParams.pm0000644000175000017500000000524112160126437027575 0ustar autarchautarchpackage HTTP::Headers::ActionPack::Core::BaseHeaderWithParams; BEGIN { $HTTP::Headers::ActionPack::Core::BaseHeaderWithParams::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::Core::BaseHeaderWithParams::VERSION = '0.09'; } # ABSTRACT: A Base header type with parameters use strict; use warnings; use Carp qw[ confess ]; use parent 'HTTP::Headers::ActionPack::Core::Base'; # NOTE: # this is meant to be # called by subclasses # in their BUILDARGS # methods # - SL sub _prepare_params { my ($class, @params) = @_; confess "Params must be an even sized list" unless (((scalar @params) % 2) == 0); my @param_order; for ( my $i = 0; $i < $#params; $i += 2 ) { push @param_order => $params[ $i ]; } return +{ params => { @params }, param_order => \@param_order }; } sub params { (shift)->{'params'} } sub _param_order { (shift)->{'param_order'} } sub add_param { my ($self, $k, $v) = @_; $self->params->{ $k } = $v; push @{ $self->_param_order } => $k; } sub remove_param { my ($self, $k) = @_; $self->{'param_order'} = [ grep { $_ ne $k } @{ $self->{'param_order'} } ]; return delete $self->params->{ $k }; } sub params_in_order { my $self = shift; map { $_, $self->params->{ $_ } } @{ $self->_param_order } } sub params_are_empty { my $self = shift; (scalar keys %{ $self->params }) == 0 ? 1 : 0 } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::Core::BaseHeaderWithParams - A Base header type with parameters =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack::Core::BaseHeaderWithParams; =head1 DESCRIPTION This is a base class for header values which contain a parameter list. There are no real user serviceable parts in here. =head1 METHODS =over 4 =item C Accessor for the unordered hash-ref of parameters. =item C Add in a parameter, it will be placed at end very end of the parameter order. =item C Remove a parameter from the link. =item C Returns false if there are no parameters on the invocant. =back =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/LinkHeader.pm0000644000175000017500000001016612160126437024732 0ustar autarchautarchpackage HTTP::Headers::ActionPack::LinkHeader; BEGIN { $HTTP::Headers::ActionPack::LinkHeader::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::LinkHeader::VERSION = '0.09'; } # ABSTRACT: A Link use strict; use warnings; use URI::Escape qw[ uri_escape uri_unescape ]; use HTTP::Headers::ActionPack::Util qw[ join_header_words ]; use parent 'HTTP::Headers::ActionPack::Core::BaseHeaderType'; sub BUILDARGS { my $class = shift; my ($href, @params) = @_; $href =~ s/^$//; $class->SUPER::BUILDARGS( $href, @params ); } sub BUILD { my $self = shift; foreach my $param ( grep { /\*$/ } @{ $self->_param_order } ) { my ($encoding, $language, $content) = ( $self->params->{ $param } =~ /^(.*)\'(.*)\'(.*)$/); $self->params->{ $param } = { encoding => $encoding, language => $language, content => uri_unescape( $content ) }; } } sub href { (shift)->subject } sub rel { (shift)->params->{'rel'} } sub relation_matches { my ($self, $relation) = @_; if ( my $rel = $self->params->{'rel'} ) { # if it is an extension rel type # then it is a URI and it should # not be compared in a case-insensitive # manner ... if ( $rel =~ m!^\w+\://! ) { $self->params->{'rel'} eq $relation ? 1 : 0; } # if it is not a URI, then compare # it case-insensitively else { (lc $self->params->{'rel'} ) eq (lc $relation) ? 1 : 0; } } } sub as_string { my $self = shift; my @params; foreach my $param ( @{ $self->_param_order } ) { if ( $param =~ /\*$/ ) { my $complex = $self->params->{ $param }; push @params => ( $param, join "'" => ( $complex->{'encoding'}, $complex->{'language'}, uri_escape( $complex->{'content'} ), ) ); } else { push @params => ( $param, $self->params->{ $param } ); } my ($encoding, $language, $content) = ( $self->params->{ $param } =~ /^(.*)\'(.*)\'(.*)$/); } join_header_words( '<' . $self->href . '>', @params ); } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::LinkHeader - A Link =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack::LinkHeader; # build from string my $link = HTTP::Headers::ActionPack::LinkHeader->new_from_string( ';rel="previous";title="previous chapter"' ); # normal constructor my $link = HTTP::Headers::ActionPack::LinkHeader->new( '' => ( rel => "previous", title => "previous chapter" ) ); # normal constructor, and <> around link are optional my $link = HTTP::Headers::ActionPack::LinkHeader->new( 'http://example.com/TheBook/chapter2' => ( rel => "previous", title => "previous chapter" ) ); =head1 DESCRIPTION This is an object which represents an HTTP Link header. It is most often used as a member of a L object. =head1 METHODS =over 4 =item C =item C This will take an HTTP header Link string and parse it into and object. =item C This stringifies the link respecting the parameter order. NOTE: This will canonicalize the header such that it will add a space between each semicolon and quotes and unquotes all headers appropriately. =back =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/PriorityList.pm0000644000175000017500000001006612160126437025400 0ustar autarchautarchpackage HTTP::Headers::ActionPack::PriorityList; BEGIN { $HTTP::Headers::ActionPack::PriorityList::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::PriorityList::VERSION = '0.09'; } # ABSTRACT: A Priority List use strict; use warnings; use HTTP::Headers::ActionPack::Util qw[ split_header_words join_header_words ]; use parent 'HTTP::Headers::ActionPack::Core::BaseHeaderList'; sub BUILDARGS { +{ 'index' => {}, 'items' => {} } } sub BUILD { my ($self, @items) = @_; foreach my $item ( @items ) { $self->add( @$item ) } } sub index { (shift)->{'index'} } sub items { (shift)->{'items'} } sub new_from_string { my ($class, $header_string) = @_; my $list = $class->new; foreach my $header ( split_header_words( $header_string ) ) { $list->add_header_value( $header ); } $list; } sub as_string { my $self = shift; join ', ' => map { my ($q, $subject) = @{ $_ }; join_header_words( $subject, q => $q ); } $self->iterable; } sub add { my ($self, $q, $choice) = @_; # XXX - should failure to canonicalize be an error? or should # canonicalize_choice itself throw an error on bad values? $choice = $self->canonicalize_choice($choice) or return; $q += 0; # be sure to numify this $self->index->{ $choice } = $q; $self->items->{ $q } = [] unless exists $self->items->{ $q }; push @{ $self->items->{ $q } } => $choice; } sub add_header_value { my $self = shift; my ($choice, %params) = @{ $_[0] }; $self->add( exists $params{'q'} ? $params{'q'} : 1.0, $choice ); } sub get { my ($self, $q) = @_; $self->items->{ $q }; } sub priority_of { my ($self, $choice) = @_; $choice = $self->canonicalize_choice($choice) or return; $self->index->{ $choice }; } sub iterable { my $self = shift; map { my $q = $_; map { [ $q, $_ ] } @{ $self->items->{ $q } } } reverse sort keys %{ $self->items }; } sub canonicalize_choice { return $_[1]; } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::PriorityList - A Priority List =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack::PriorityList; # simple constructor my $plist = HTTP::Headers::ActionPack::PriorityList->new( [ 1.0 => 'foo' ], [ 0.5 => 'bar' ], [ 0.2 => 'baz' ], ); # from headers my $plist = HTTP::Headers::ActionPack::PriorityList->new_from_string( 'foo; q=1.0, bar; q=0.5, baz; q=0.2' ); =head1 DESCRIPTION This is a simple priority list implementation, this is used to handle the Accept-* headers as they typically will contain values along with a "q" value to indicate quality. =head1 METHODS =over 4 =item C =item C This accepts a HTTP header string which get parsed and loaded accordingly. =item C =item C =item C Add in a new C<$choice> with a given C<$quality>. =item C Given a certain C<$quality>, it returns the various choices available. =item C Given a certain C<$choice> this returns the associated quality of it. =item C This returns a list of two item ARRAY refs with the quality as the first item and the associated choice as the second item. These are sorted accordingly. When two items have the same priority, they are returned in the order that they were found in the header. =item C By default, this does nothing. It exists so that subclasses can override it. =back =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/DateHeader.pm0000644000175000017500000000661412160126437024715 0ustar autarchautarchpackage HTTP::Headers::ActionPack::DateHeader; BEGIN { $HTTP::Headers::ActionPack::DateHeader::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::DateHeader::VERSION = '0.09'; } # ABSTRACT: A Date Header use strict; use warnings; use HTTP::Headers::ActionPack::Util qw[ header_to_date date_to_header ]; use parent 'HTTP::Headers::ActionPack::Core::Base'; sub BUILDARGS { my (undef, $date) = @_; +{ date => $date } } sub new_from_string { my ($class, $header_string) = @_; $class->new( header_to_date( $header_string ) ); } sub as_string { date_to_header( (shift)->{'date'} ) } # implement a simple API sub second { (shift)->{'date'}->second } sub minute { (shift)->{'date'}->minute } sub hour { (shift)->{'date'}->hour } sub day_of_month { (shift)->{'date'}->day_of_month } sub month_number { (shift)->{'date'}->mon } sub fullmonth { (shift)->{'date'}->fullmonth } sub month { (shift)->{'date'}->month } sub year { (shift)->{'date'}->year } sub day_of_week { (shift)->{'date'}->day_of_week } sub day { (shift)->{'date'}->day } sub fullday { (shift)->{'date'}->fullday } sub epoch { (shift)->{'date'}->epoch } sub date { (shift)->{'date'} } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::DateHeader - A Date Header =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack::DateHeader; # create from string my $date = HTTP::Headers::ActionPack::DateHeader->new_from_string( 'Mon, 23 Apr 2012 14:14:19 GMT' ); # create using Time::Peice object my $date = HTTP::Headers::ActionPack::DateHeader->new( $timepeice_object ); =head1 DESCRIPTION This is an object which represents an HTTP header with a date. It will inflate the header value into a L object and proxy most of the relevant methods. =head1 DateTime compatibility I opted to not use L (by default) for this class since it is not a core module and can be a memory hog at times. That said, it should be noted that L objects are compatible with this class. You will need to pass in a L instance to C and after that everything should behave properly. If you want C to inflate strings to L objects you will need to override that method yourself. =head1 METHODS =over 4 =item C Returns the underlying L object. =item C This will take an HTTP header Date string and parse it into and object. =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C These delegate to the underlying L object. =back =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/Util.pm0000644000175000017500000000534112160126437023640 0ustar autarchautarchpackage HTTP::Headers::ActionPack::Util; BEGIN { $HTTP::Headers::ActionPack::Util::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::Util::VERSION = '0.09'; } # ABSTRACT: General Utility module use strict; use warnings; use Time::Piece; use HTTP::Date qw[ str2time time2str ]; use HTTP::Headers::Util; use Sub::Exporter -setup => { exports => [qw[ header_to_date date_to_header split_header_words join_header_words join_header_params ]] }; sub header_to_date { scalar Time::Piece->gmtime( str2time( shift ) ) } sub date_to_header { time2str( shift->epoch ) } sub split_header_words { my $header = shift; map { splice @$_, 1, 1; $_; } HTTP::Headers::Util::_split_header_words( $header ); } sub join_header_words { my ($subject, @params) = @_; return $subject . '; ' . join_header_params( '; ' => @params ) if @params; return $subject; } sub join_header_params { my ($separator, @params) = @_; my @attrs; while ( @params ) { my $k = shift @params; my $v = shift @params; if (defined $v) { $v =~ s/([\"\\])/\\$1/g; # escape " and \ } else { $v = q{}; } push @attrs => ($k . qq(="$v")); } return join $separator => @attrs; } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::Util - General Utility module =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack::Util; =head1 DESCRIPTION This is just a basic utility module used internally by L. There are no real user serviceable parts in here. =head1 FUNCTIONS =over 4 =item C This is imported from L and passed on here for export. =item C This will split up a header, respecting all the quoted strings and such, and return the subject, followed by an array of parameter pairs. The parameters are returned as an array so that ordering can be preserved. =item C This will canonicalize the header such that it will add a space between each semicolon and quote and escape all headers values appropriately. =back =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/MediaType.pm0000644000175000017500000001204712160126437024605 0ustar autarchautarchpackage HTTP::Headers::ActionPack::MediaType; BEGIN { $HTTP::Headers::ActionPack::MediaType::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::MediaType::VERSION = '0.09'; } # ABSTRACT: A Media Type use strict; use warnings; use Scalar::Util qw[ blessed ]; use parent 'HTTP::Headers::ActionPack::Core::BaseHeaderType'; sub type { (shift)->subject } sub major { (split '/' => (shift)->type)[0] } sub minor { (split '/' => (shift)->type)[1] } sub matches_all { my $self = shift; $self->type eq '*/*' && $self->params_are_empty ? 1 : 0; } # must be exactly the same sub equals { my ($self, $other) = @_; $other = (ref $self)->new_from_string( $other ) unless blessed $other; $other->type eq $self->type && _compare_params( $self->params, $other->params ) ? 1 : 0; } # types must be compatible and params much match exactly sub exact_match { my ($self, $other) = @_; $other = (ref $self)->new_from_string( $other ) unless blessed $other; $self->type_matches( $other ) && _compare_params( $self->params, $other->params ) ? 1 : 0; } # types must be be compatible and params should align sub match { my ($self, $other) = @_; $other = (ref $self)->new_from_string( $other ) unless blessed $other; $self->type_matches( $other ) && $self->params_match( $other->params ) ? 1 : 0; } ## ... sub type_matches { my ($self, $other) = @_; return 1 if $other->type eq '*' || $other->type eq '*/*' || $other->type eq $self->type; $other->major eq $self->major && $other->minor eq '*' ? 1 : 0; } sub params_match { my ($self, $other) = @_; my $params = $self->params; foreach my $k ( keys %$other ) { next if $k eq 'q'; return 0 if not exists $params->{ $k }; return 0 if $params->{ $k } ne $other->{ $k }; } return 1; } ## ... sub _compare_params { my ($left, $right) = @_; my @left_keys = sort grep { $_ ne 'q' } keys %$left; my @right_keys = sort grep { $_ ne 'q' } keys %$right; return 0 unless (scalar @left_keys) == (scalar @right_keys); foreach my $i ( 0 .. $#left_keys ) { return 0 unless $left_keys[$i] eq $right_keys[$i]; return 0 unless $left->{ $left_keys[$i] } eq $right->{ $right_keys[$i] }; } return 1; } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::MediaType - A Media Type =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack::MediaType; # normal constructor my $mt = HTTP::Headers::ActionPack::MediaType->new( 'application/xml' => ( 'q' => 0.5, 'charset' => 'UTF-8' ) ); # construct from string my $mt = HTTP::Headers::ActionPack::MediaType->new_from_string( 'application/xml; q=0.5; charset=UTF-8' ); =head1 DESCRIPTION This is an object which represents an HTTP media type definition. This is most often found as a member of a L object. =head1 METHODS =over 4 =item C Accessor for the type. =item C The major portion of the media type name. =item C The minor portion of the media type name. =item C A media type matched all if the type is C<*/*> and if it has no parameters. =item C This will attempt to determine if the C<$media_type> is exactly the same as itself. If given a C<$media_type_string> it will parse it into an object. In order for two type to be equal, the types must match exactly and the parameters much match exactly. =item C This will attempt to determine if the C<$media_type> is a match with itself using the C method below. If given a C<$media_type_string> it will parse it into an object. In order for an exact match to occur it the types must be compatible and the parameters much match exactly. =item C This will attempt to determine if the C<$media_type> is a match with itself using the C method and C method below. If given a C<$media_type_string> it will parse it into an object. In order for an exact match to occur it the types must be compatible and the parameters must be a subset. =item C This will determine type compatibility, properly handling the C<*> types and major and minor elements of the type. =item C This determines if the C<$parameters> are a subset of the invocants parameters. =back =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/Authorization.pm0000644000175000017500000000703512160126437025565 0ustar autarchautarchpackage HTTP::Headers::ActionPack::Authorization; BEGIN { $HTTP::Headers::ActionPack::Authorization::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::Authorization::VERSION = '0.09'; } # ABSTRACT: The Authorization Header factory use strict; use warnings; use HTTP::Headers::ActionPack::Authorization::Basic; use HTTP::Headers::ActionPack::Authorization::Digest; sub new { my $class = shift; my $type = shift; $type eq 'Basic' ? HTTP::Headers::ActionPack::Authorization::Basic->new( $type, @_ ) : HTTP::Headers::ActionPack::Authorization::Digest->new( $type, @_ ); } sub new_from_string { my ($class, $header_string) = @_; $header_string =~ /^Basic/ ? HTTP::Headers::ActionPack::Authorization::Basic->new_from_string( $header_string ) : HTTP::Headers::ActionPack::Authorization::Digest->new_from_string( $header_string ); } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::Authorization - The Authorization Header factory =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack::Authorization; # create HTTP::Headers::ActionPack::Authorization::Basic objects ... # create from string my $auth = HTTP::Headers::ActionPack::Authorization->new_from_string( 'Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==' ); # create from parameters my $auth = HTTP::Headers::ActionPack::Authorization->new( 'Basic' => { username => 'Aladdin', password => 'open sesame' } ); my $auth = HTTP::Headers::ActionPack::Authorization->new( 'Basic' => [ 'Aladdin', 'open sesame' ] ); my $auth = HTTP::Headers::ActionPack::Authorization->new( 'Basic' => 'QWxhZGRpbjpvcGVuIHNlc2FtZQ==' ); # or HTTP::Headers::ActionPack::Authorization::Digest objects ... # create from string my $auth = HTTP::Headers::ActionPack::Authorization->new_from_string( q{Digest username="jon.dough@mobile.biz", realm="RoamingUsers@mobile.biz", nonce="CjPk9mRqNuT25eRkajM09uTl9nM09uTl9nMz5OX25PZz==", uri="sip:home.mobile.biz", qop=auth-int, nc=00000001, cnonce="0a4f113b", response="6629fae49393a05397450978507c4ef1", opaque="5ccc069c403ebaf9f0171e9517f40e41"} ); # create from parameters my $auth = HTTP::Headers::ActionPack::Authorization->new( 'Digest' => ( username => 'jon.dough@mobile.biz', realm => 'RoamingUsers@mobile.biz', nonce => "CjPk9mRqNuT25eRkajM09uTl9nM09uTl9nMz5OX25PZz==", uri => "sip:home.mobile.biz", qop => 'auth-int', nc => '00000001', cnonce => "0a4f113b", response => "6629fae49393a05397450978507c4ef1", opaque => "5ccc069c403ebaf9f0171e9517f40e41" ) ); =head1 DESCRIPTION This is a factory class that can be used to create the appropriate subclass based on the type of Authorization header. =head1 METHODS =over 4 =item C =item C =back =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/MediaTypeList.pm0000644000175000017500000001077512160126437025447 0ustar autarchautarchpackage HTTP::Headers::ActionPack::MediaTypeList; BEGIN { $HTTP::Headers::ActionPack::MediaTypeList::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::MediaTypeList::VERSION = '0.09'; } # ABSTRACT: A Priority List customized for Media Types use strict; use warnings; use Scalar::Util qw[ blessed ]; use HTTP::Headers::ActionPack::MediaType; use parent 'HTTP::Headers::ActionPack::PriorityList'; sub BUILD { my ($self, @items) = @_; foreach my $item ( @items ) { $self->add( ref $item eq 'ARRAY' ? @$item : $item ) } } sub add { my $self = shift; my ($q, $mt) = scalar @_ == 1 ? ((exists $_[0]->params->{'q'} ?$_[0]->params->{'q'} : 1.0), $_[0]) : @_; $self->SUPER::add( $q, $mt ); } sub add_header_value { my $self = shift; my $mt = HTTP::Headers::ActionPack::MediaType->new( @{ $_[0] } ); my $q = $mt->params->{'q'} || 1.0; $self->add( $q, $mt ); } sub as_string { my $self = shift; join ', ' => map { $_->[1]->as_string } $self->iterable; } sub iterable { my $self = shift; # From RFC-2616 sec14 # Media ranges can be overridden by more specific # media ranges or specific media types. If more # than one media range applies to a given type, # the most specific reference has precedence. sort { if ( $a->[0] == $b->[0] ) { $a->[1]->matches_all ? 1 : ($b->[1]->matches_all ? -1 : ($a->[1]->minor eq '*' ? 1 : ($b->[1]->minor eq '*' ? -1 : ($a->[1]->params_are_empty ? 1 : ($b->[1]->params_are_empty ? -1 : 0))))) } else { $b->[0] <=> $a->[0] } } map { my $q = $_; map { [ $q+0, $_ ] } reverse @{ $self->items->{ $q } } } keys %{ $self->items }; } sub canonicalize_choice { return blessed $_[1] ? $_[1] : HTTP::Headers::ActionPack::MediaType->new( $_[1] ); } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::MediaTypeList - A Priority List customized for Media Types =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack::MediaTypeList; # normal constructor my $list = HTTP::Headers::ActionPack::MediaTypeList->new( HTTP::Headers::ActionPack::MediaType->new('audio/*', q => 0.2 ), HTTP::Headers::ActionPack::MediaType->new('audio/basic', q => 1.0 ) ); # you can also specify the 'q' # rating independent of the # media type definition my $list = HTTP::Headers::ActionPack::MediaTypeList->new( [ 0.2 => HTTP::Headers::ActionPack::MediaType->new('audio/*', q => 0.2 ) ], [ 1.0 => HTTP::Headers::ActionPack::MediaType->new('audio/basic' ) ] ); # or from a string my $list = HTTP::Headers::ActionPack::MediaTypeList->new_from_string( 'audio/*; q=0.2, audio/basic' ); =head1 DESCRIPTION This is a subclass of the L class with some specific media-type features. It is the default object used to parse most of the C header since they will often contain more then one media type. =head1 METHODS =over 4 =item C This returns the same data type as the parent (two element ARRAY ref with quality and choice), but the choice element will be a L object. This is also sorted in a very specific manner in order to align with RFC-2616 Sec14. Media ranges can be overridden by more specific media ranges or specific media types. If more than one media range applies to a given type, the most specific reference has precedence. =item C If this is passed a string, it returns a new L object from that string. If it receives an object it simply returns that object as is. =back =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/ContentNegotiation.pm0000644000175000017500000001703112160126437026535 0ustar autarchautarchpackage HTTP::Headers::ActionPack::ContentNegotiation; BEGIN { $HTTP::Headers::ActionPack::ContentNegotiation::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::ContentNegotiation::VERSION = '0.09'; } # ABSTRACT: A class to handle content negotiation use strict; use warnings; use Carp qw[ confess ]; use Scalar::Util qw[ blessed ]; use List::Util qw[ first ]; sub new { my $class = shift; my $action_pack = shift; (blessed $action_pack && $action_pack->isa('HTTP::Headers::ActionPack')) || confess "You must supply an instance of HTTP::Headers::ActionPack"; bless { action_pack => $action_pack } => $class; } sub action_pack { (shift)->{'action_pack'} } sub choose_media_type { my ($self, $provided, $header) = @_; my $requested = blessed $header ? $header : $self->action_pack->create( 'MediaTypeList' => $header ); my $parsed_provided = [ map { $self->action_pack->create( 'MediaType' => $_ ) } @$provided ]; my $chosen; foreach my $request ( $requested->iterable ) { my $requested_type = $request->[1]; $chosen = _media_match( $requested_type, $parsed_provided ); return $chosen if $chosen; } return; } sub choose_language { my ($self, $provided, $header) = @_; return $self->_make_choice( choices => $provided, header => $header, class => 'AcceptLanguage', matcher => \&_language_match, ); } sub choose_charset { my ($self, $provided, $header) = @_; # NOTE: # Making the default charset UTF-8, which # is maybe sensible, I dunno. # - SL return $self->_make_choice( choices => $provided, header => $header, class => 'AcceptCharset', default => 'UTF-8', matcher => \&_simple_match, ); } sub choose_encoding { my ($self, $provided, $header) = @_; return $self->_make_choice( choices => $provided, header => $header, class => 'PriorityList', default => 'identity', matcher => \&_simple_match, ); } sub _make_choice { my $self = shift; my %args = @_; my ($choices, $header, $class, $default, $matcher) = @args{qw( choices header class default matcher )}; return if @$choices == 0; return if $header eq ''; my $accepted = blessed $header ? $header : $self->action_pack->create( $class => $header ); my $star_priority = $accepted->priority_of( '*' ); my @canonical = map { my $c = $accepted->canonicalize_choice($_); $c ? [ $_, $c ] : () } @$choices; my ($default_ok, $any_ok); if ($default) { $default = $accepted->canonicalize_choice($default); my $default_priority = $accepted->priority_of( $args{default} ); if ( not defined $default_priority ) { if ( defined $star_priority && $star_priority == 0.0 ) { $default_ok = 0; } else { $default_ok = 1; } } elsif ( $default_priority == 0.0 ) { $default_ok = 0; } else { $default_ok = 1; } } if ( not defined $star_priority ) { $any_ok = 0; } elsif ( $star_priority == 0.0 ) { $any_ok = 0; } else { $any_ok = 1; } my $chosen; for my $item ($accepted->iterable) { my ($priority, $acceptable) = @$item; next if $priority == 0; if (my $match = first { $matcher->( $acceptable, $_->[1] ) } @canonical) { $chosen = $match->[0]; last; } } return $chosen if $chosen; if ($any_ok) { my $match = first { my $priority = $accepted->priority_of( $_->[1] ); return 1 unless defined $priority && $priority == 0; return 0; } @canonical; return $match->[0] if $match; } if ( $default && $default_ok ) { my $match = first { $matcher->( $default, $_->[1] ) } @canonical; if ($match) { my $priority = $accepted->priority_of( $match->[1] ); return $match->[0] unless defined $priority && $priority == 0; } } return; } ## .... sub _media_match { my ($requested, $provided) = @_; return $provided->[0] if $requested->matches_all; return first { $_->match( $requested ) } @$provided; } sub _language_match { my ($range, $tag) = @_; ((lc $range) eq (lc $tag)) || $range eq "*" || $tag =~ /^$range\-/i; } sub _simple_match { return $_[0] eq $_[1]; } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::ContentNegotiation - A class to handle content negotiation =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack; my $n = HTTP::Headers::ActionPack->new->get_content_negotiator; # matches text/html; charset="iso8859-1" $n->choose_media_type( ["text/html", "text/html;charset=iso8859-1" ], "text/html;charset=iso8859-1, application/xml" ); # matches en-US $n->choose_language( ['en-US', 'es'], "da, en-gb;q=0.8, en;q=0.7" ); # matches US-ASCII $n->choose_charset( [ "UTF-8", "US-ASCII" ], "US-ASCII, UTF-8" ); # matches gzip $n->choose_encoding( [ "gzip", "identity" }, "gzip, identity;q=0.7" ); =head1 DESCRIPTION This class provides a set of methods used for content negotiation. It makes full use of all the header objects, such as L, L and L. Content negotiation is a tricky business, it needs to account for such things as the quality rating, order of elements (both in the header and in the list of provided items) and in the case of media types it gets even messier. This module does it's best to figure things out and do what is expected on it. We have included a number of examples from the RFC documents in our test suite as well. =head1 METHODS =over 4 =item C Given an ARRAY ref of media type strings and an HTTP header, this will return the appropriately matching L instance. =item C Given a list of language codes and an HTTP header value, this will attempt to negotiate the best language match. It will return the language string that best matched. =item C Given a list of charset names and an HTTP header value, this will attempt to negotiate the best charset match. It will return the name of the charset that best matched. =item C Given a list of encoding names and an HTTP header value, this will attempt to negotiate the best encoding match. It will return the name of the encoding which best matched. =back =head1 SEE ALSO L There is nothing wrong with this module, however it attempts to answer all the negotiation questions at once, whereas this module allows you to do it one thing at a time. =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/LinkList.pm0000644000175000017500000000316112160126437024452 0ustar autarchautarchpackage HTTP::Headers::ActionPack::LinkList; BEGIN { $HTTP::Headers::ActionPack::LinkList::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::LinkList::VERSION = '0.09'; } # ABSTRACT: A List of Link objects use strict; use warnings; use HTTP::Headers::ActionPack::LinkHeader; use parent 'HTTP::Headers::ActionPack::Core::BaseHeaderList'; sub BUILDARGS { shift; +{ items => [ @_ ] } } sub items { (shift)->{'items'} } sub add { my ($self, $link) = @_; push @{ $self->items } => $link; } sub add_header_value { my ($self, $value) = @_; $self->add( HTTP::Headers::ActionPack::LinkHeader->new( @$value ) ); } sub iterable { @{ (shift)->items } } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::LinkList - A List of Link objects =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack::LinkList; =head1 DESCRIPTION This is a simple list of Links since the Link header can legally have more then one link in it. =head1 METHODS =over 4 =item C =item C =item C =back =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/lib/HTTP/Headers/ActionPack/AcceptCharset.pm0000644000175000017500000000552712160126437025442 0ustar autarchautarchpackage HTTP::Headers::ActionPack::AcceptCharset; BEGIN { $HTTP::Headers::ActionPack::AcceptCharset::AUTHORITY = 'cpan:STEVAN'; } { $HTTP::Headers::ActionPack::AcceptCharset::VERSION = '0.09'; } # ABSTRACT: A Priority List customized for Media Types use strict; use warnings; use Encode qw[ find_encoding ]; use parent 'HTTP::Headers::ActionPack::PriorityList'; sub new_from_string { my $self = shift->SUPER::new_from_string(@_); # From RFC-2616 sec14.2 # If no "*" is present in an Accept-Charset # field, then all character sets not explicitly # mentioned get a quality value of 0, except for # ISO-8859-1, which gets a quality value of 1 # if not explicitly mentioned. unless ( defined $self->priority_of('*') || defined $self->priority_of('ISO-8859-1') ) { $self->add( 1 => 'ISO-8859-1' ); } return $self; } sub canonicalize_choice { return unless defined $_[1]; return '*' if $_[1] eq '*'; my $charset = find_encoding($_[1]) or return; return $charset->mime_name; } 1; __END__ =pod =head1 NAME HTTP::Headers::ActionPack::AcceptCharset - A Priority List customized for Media Types =head1 VERSION version 0.09 =head1 SYNOPSIS use HTTP::Headers::ActionPack::AcceptCharset; # normal constructor my $list = HTTP::Headers::ActionPack::AcceptCharset->new( [ 1.0 => 'UTF-8' ], [ 0.7 => 'ISO-8859-1' ], ); # or from a string my $list = HTTP::Headers::ActionPack::AcceptCharsetList->new_from_string( 'UTF-8; q=1.0, ISO-8859-1; q=0.7' ); =head1 DESCRIPTION This is a subclass of the L class with some charset specific features. =head1 METHODS =over 4 =item C This method overrides the default constructor to add some additional logic required by RFC-2616. If an Accept-Charset header does not explicitly define the priority for "*" or "ISO-8859-1", then the default priority for "ISO-8859-1" must be set to 1.0. Note that we do not override the C method. If you are passing an explicitly list of values to the constructor we assume you know what you are doing. =item C This takes a string containing a character set name and returns the canonical MIME name for the character set. For example, it transforms "utf8" to "UTF-8". =back =head1 AUTHOR Stevan Little =head1 CONTRIBUTORS =over 4 =item * Andrew Nelson =item * Dave Rolsky =item * Florian Ragwitz =item * Jesse Luehrs =item * Karen Etheridge =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Headers-ActionPack-0.09/README0000644000175000017500000000050712160126437016330 0ustar autarchautarch This archive contains the distribution HTTP-Headers-ActionPack, version 0.09: HTTP Action, Adventure and Excitement This software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. HTTP-Headers-ActionPack-0.09/eg/0000775000175000017500000000000012160126437016043 5ustar autarchautarchHTTP-Headers-ActionPack-0.09/eg/torture-test0000644000175000017500000000252212160126437020446 0ustar autarchautarch#!perl use strict; use warnings; use lib 'lib'; use File::Find qw( find ); use HTTP::Headers; use HTTP::Headers::ActionPack; my $pack = HTTP::Headers::ActionPack->new(); find( { wanted => \&process, no_chdir => 1, }, 'headers', ); my $count = 0; sub process { my $file = $_; return unless -f $_; $count++; open my $fh, '<', $file; # First line is the request itself, not headers scalar <$fh>; my @h; while (<$fh>) { last unless /\S/; $_ =~ s/[\r\n]//g; push @h, $_; } _check_inflate(\@h); warn "\nProcessed $count files\n" if $count % 1000 == 0; return; } sub _check_inflate { my $headers = HTTP::Headers->new( map { split /:\s*/, $_, 2 } @{ $_[0] } ); my @warnings; my $e; { local $SIG{__WARN__} = sub { push @warnings, @_ }; local $@; eval { my ( $name, $value ) = split /:\s*/, $_[0], 2; $pack->inflate($headers); }; $e = $@; } if ($e) { warn "** Error **\n"; warn " $_\n" for @{ $_[0] }; warn "\n"; warn " $e\n"; warn "\n\n"; } if (@warnings) { warn "** Warnings **\n"; warn " $_[0]\n"; warn " $_\n" for @warnings; warn "\n\n"; } } HTTP-Headers-ActionPack-0.09/LICENSE0000644000175000017500000004372512160126437016466 0ustar autarchautarchThis software is copyright (c) 2012 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2012 by Infinity Interactive, Inc.. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2012 by Infinity Interactive, Inc.. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End HTTP-Headers-ActionPack-0.09/META.yml0000644000175000017500000000224712160126437016724 0ustar autarchautarch--- abstract: 'HTTP Action, Adventure and Excitement' author: - 'Stevan Little ' build_requires: HTTP::Headers: 0 HTTP::Request: 0 HTTP::Response: 0 Test::Fatal: 0.0003 Test::More: 0.88 Test::Warnings: 0 configure_requires: ExtUtils::MakeMaker: 6.30 dynamic_config: 0 generated_by: 'Dist::Zilla version 4.300034, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: HTTP-Headers-ActionPack requires: Carp: 0 Encode: 0 HTTP::Date: 0 HTTP::Headers::Util: 0 List::Util: 0 MIME::Base64: 0 Module::Runtime: 0 Scalar::Util: 0 Sub::Exporter: 0 Time::Piece: 0 URI::Escape: 0 overload: 0 parent: 0 strict: 0 warnings: 0 resources: bugtracker: https://rt.cpan.org/Dist/Display.html?Name=HTTP::Headers::ActionPack repository: https://github.com/stevan/http-headers-actionpack.git version: 0.09 x_authority: cpan:STEVAN x_contributors: - 'Andrew Nelson ' - 'Dave Rolsky ' - 'Florian Ragwitz ' - 'Jesse Luehrs ' - 'Karen Etheridge ' HTTP-Headers-ActionPack-0.09/weaver.ini0000644000175000017500000000040712160126437017441 0ustar autarchautarch[@CorePrep] [Name] [Version] [Region / prelude] [Generic / SYNOPSIS] [Generic / DESCRIPTION] [Generic / OVERVIEW] [Collect / ATTRIBUTES] command = attr [Collect / METHODS] command = method [Leftovers] [Region / postlude] [Authors] [Contributors] [Legal]HTTP-Headers-ActionPack-0.09/Makefile.PL0000644000175000017500000000354212160126437017424 0ustar autarchautarch use strict; use warnings; use ExtUtils::MakeMaker 6.30; my %WriteMakefileArgs = ( "ABSTRACT" => "HTTP Action, Adventure and Excitement", "AUTHOR" => "Stevan Little ", "BUILD_REQUIRES" => {}, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.30" }, "DISTNAME" => "HTTP-Headers-ActionPack", "EXE_FILES" => [], "LICENSE" => "perl", "NAME" => "HTTP::Headers::ActionPack", "PREREQ_PM" => { "Carp" => 0, "Encode" => 0, "HTTP::Date" => 0, "HTTP::Headers::Util" => 0, "List::Util" => 0, "MIME::Base64" => 0, "Module::Runtime" => 0, "Scalar::Util" => 0, "Sub::Exporter" => 0, "Time::Piece" => 0, "URI::Escape" => 0, "overload" => 0, "parent" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "HTTP::Headers" => 0, "HTTP::Request" => 0, "HTTP::Response" => 0, "Test::Fatal" => "0.0003", "Test::More" => "0.88", "Test::Warnings" => 0 }, "VERSION" => "0.09", "test" => { "TESTS" => "t/*.t" } ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { my $tr = delete $WriteMakefileArgs{TEST_REQUIRES}; my $br = $WriteMakefileArgs{BUILD_REQUIRES}; for my $mod ( keys %$tr ) { if ( exists $br->{$mod} ) { $br->{$mod} = $tr->{$mod} if $tr->{$mod} > $br->{$mod}; } else { $br->{$mod} = $tr->{$mod}; } } } unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) { my $br = delete $WriteMakefileArgs{BUILD_REQUIRES}; my $pp = $WriteMakefileArgs{PREREQ_PM}; for my $mod ( keys %$br ) { if ( exists $pp->{$mod} ) { $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod}; } else { $pp->{$mod} = $br->{$mod}; } } } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); HTTP-Headers-ActionPack-0.09/README.md0000644000175000017500000000275112160126437016732 0ustar autarchautarch # HTTP::Headers::ActionPack ### HTTP Action, Adventure and Excitement This module provides a set of objects which can serialize and deserialize complex HTTP header types. This is useful if you need to interrogate the values in these headers for specific purposes such as content negotiation, link following, etc. The following headers are supported: * Link * as specificed in [http://tools.ietf.org/html/rfc5988] * Content-Type * as specified in [http://www.w3.org/Protocols/rfc2616/rfc2616-sec3.html#sec3.7] * Accept * parses each media type and organizes them into a priority list * Accept-Charset, Accept-Encoding and Accept-Language * parses into a priority list * Date, Expires, Last-Modified, If-Unmodified-Since and If-Modified-Since * parses into a Date object (which is just a wrapped Time::Piece object) * Authorization, Authentication-Info and WWW-Authenticate * this will handle Basic, Digest when appropriate * follows the examples in [http://www.ietf.org/rfc/rfc2617.txt] There is plans to support these headers as well: * Content-Disposition * as specified in [http://www.ietf.org/rfc/rfc2183.txt] * User-Agent * should use a module for this since it is such a mess * Content-Range and Range * basic range parsing And if we ever need them, we can support these headers as well: * Cache-Control * there are lots of things here, but eventually we might need it * Expect * not even really sure what this would need, but its a possibility HTTP-Headers-ActionPack-0.09/Changes0000644000175000017500000000411012160126437016735 0ustar autarchautarch0.09 Tue. Jun. 18, 2013 - If a header param's value somehow ended up as undef, this would produce an unitialized value warning. (Dave Rolsky) 0.08 Tue. Apr. 23, 2013 - Fixed a bug in the handling of defaults in content negotiation that could lead to errors like: Can't use string ("5") as an ARRAY ref while "strict refs" in use at /opt/perl5.16.3/lib/site_perl/5.16.3/HTTP/Headers/ActionPack/ContentNegotiation.pm line 160. (Dave Rolsky) 0.07 Tue. Apr. 16, 2013 - The PriorityList class treated "q=0" as if it was "q=1". RFC 2616 makes it clear that "0" is fine. (Dave Rolsky) 0.06 Mon. Apr. 15, 2013 - Language and character set negotiation now canonicalize all values. This means that if you say you provide "UTF-8" and a client requests "utf8" it will just work. (Dave Rolsky) - There are two new classes, HTTP::Headers::ActionPackage::AcceptCharset and AcceptLanguage. (Dave Rolsky) - If an Accept-Charset header does not contain "*" or "ISO-8859-1", then "ISO-8859-1" is given a priority of 1.0, per RFC-2616. (Dave Rolsky) - Content negotiation will never return any item explicitly forbidden ("q=0.0") in the headers, even if the header says it accepts "*" or that item is specified as a default in your code. (Dave Rolsky) - The HTTP::Headers::ActionPack->inflate method now works with Web::Request object. (Jesse Luehrs) - Fix tests that were broken in the absence of HTTP::Message::PSGI. (Florian Ragwitz) 0.05 Mon. Nov. 26th, 2012 - fixed the HTTP::Message::PSGI errors - when you inflate a header object that has already been inflated, ignore that header and keep looping - thanks to Florian Ragwitz for spoting this 0.04 Sun. Sept. 9th, 2012 - pulling the content negotiation out of Web::Machine and moving it into here - adding tests accordingly 0.03 Tues. June 19th, 2012 - make sure everything has $VERSION numbers 0.02 Sun. June 17th, 2012 - forgot to add some dependencies 0.01 Tues. June 12th, 2012 - First release HTTP-Headers-ActionPack-0.09/META.json0000644000175000017500000000425412160126437017074 0ustar autarchautarch{ "abstract" : "HTTP Action, Adventure and Excitement", "author" : [ "Stevan Little " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 4.300034, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "HTTP-Headers-ActionPack", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.30" } }, "develop" : { "requires" : { "Test::Pod" : "1.41" } }, "runtime" : { "requires" : { "Carp" : "0", "Encode" : "0", "HTTP::Date" : "0", "HTTP::Headers::Util" : "0", "List::Util" : "0", "MIME::Base64" : "0", "Module::Runtime" : "0", "Scalar::Util" : "0", "Sub::Exporter" : "0", "Time::Piece" : "0", "URI::Escape" : "0", "overload" : "0", "parent" : "0", "strict" : "0", "warnings" : "0" } }, "test" : { "requires" : { "HTTP::Headers" : "0", "HTTP::Request" : "0", "HTTP::Response" : "0", "Test::Fatal" : "0.0003", "Test::More" : "0.88", "Test::Warnings" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-http-headers-actionpack@rt.cpan.org", "web" : "https://rt.cpan.org/Dist/Display.html?Name=HTTP::Headers::ActionPack" }, "repository" : { "type" : "git", "url" : "https://github.com/stevan/http-headers-actionpack.git", "web" : "https://github.com/stevan/http-headers-actionpack" } }, "version" : "0.09", "x_authority" : "cpan:STEVAN", "x_contributors" : [ "Andrew Nelson ", "Dave Rolsky ", "Florian Ragwitz ", "Jesse Luehrs ", "Karen Etheridge " ] } HTTP-Headers-ActionPack-0.09/INSTALL0000644000175000017500000000201312160126437016473 0ustar autarchautarch This is the Perl distribution HTTP-Headers-ActionPack. Installing HTTP-Headers-ActionPack is straightforward. ## Installation with cpanm If you have cpanm, you only need one line: % cpanm HTTP::Headers::ActionPack If you are installing into a system-wide directory, you may need to pass the "-S" flag to cpanm, which uses sudo to install the module: % cpanm -S HTTP::Headers::ActionPack ## Installing with the CPAN shell Alternatively, if your CPAN shell is set up, you should just be able to do: % cpan HTTP::Headers::ActionPack ## Manual installation As a last resort, you can manually install it. Download the tarball, untar it, then build it: % perl Makefile.PL % make && make test Then install it: % make install If you are installing into a system-wide directory, you may need to run: % sudo make install ## Documentation HTTP-Headers-ActionPack documentation is available as POD. You can run perldoc from a shell to read the documentation: % perldoc HTTP::Headers::ActionPack HTTP-Headers-ActionPack-0.09/dist.ini0000644000175000017500000000222512160126437017113 0ustar autarchautarchname = HTTP-Headers-ActionPack author = Stevan Little license = Perl_5 copyright_holder = Infinity Interactive, Inc. copyright_year = 2012 version = 0.09 [@Basic] [InstallGuide] [MetaJSON] [NextRelease] format=%v %{EEE. MMM. dd, YYYY}d [PkgVersion] [Authority] authority = cpan:STEVAN [MetaResources] bugtracker.web = https://rt.cpan.org/Dist/Display.html?Name=HTTP::Headers::ActionPack bugtracker.mailto = bug-http-headers-actionpack@rt.cpan.org repository.url = https://github.com/stevan/http-headers-actionpack.git repository.web = https://github.com/stevan/http-headers-actionpack repository.type = git [NoTabsTests] [PodSyntaxTests] [Test::Pod::LinkCheck] [Test::Pod::No404s] [Test::PodSpelling] stopwords = Auth stopwords = Charset stopwords = Etheridge stopwords = Luehrs stopwords = Ragwitz stopwords = Rolsky stopwords = TW stopwords = invocant stopwords = invocants stopwords = stringifying stopwords = subclasses stopwords = unordered stopwords = utf stopwords = zh [TestRelease] [ConfirmRelease] [ContributorsFromGit] [PodWeaver] [AutoPrereqs] [CheckPrereqsIndexed] [@Git]