view release on metacpan or  search on metacpan

t/07.accept.t  view on Meta::CPAN

#!/usr/bin/env perl
BEGIN
{
    use strict;
    use warnings;
    use lib './lib';
    use open ':std' => ':utf8';
    use Test::More;
    use Module::Generic::Global ':const';
    use vars qw( $DEBUG );
    our $DEBUG = exists( $ENV{AUTHOR_TESTING} ) ? $ENV{AUTHOR_TESTING} : 0;
};

BEGIN
{
    use ok( 'Apache2::API::Headers::Accept' ) || BAIL_OUT( 'Unable to load Apache2::API::Headers::Accept' );
};

use strict;
use warnings;

my $accept = Apache2::API::Headers::Accept->new( 'text/html, application/json;q=0.5', debug => $DEBUG );
isa_ok( $accept, 'Apache2::API::Headers::Accept' );

# To generate this list:
# perl -lnE '/^sub (?!init|[A-Z]|_)/ and say "can_ok( \$accept, \''", [split(/\s+/, $_)]->[1], "\'' );"' ./lib/Apache2/API/Headers/AcceptCommon.pm ./lib/Apache2/API/Headers/Accept.pm
can_ok( $accept, 'header' );
can_ok( $accept, 'match' );
can_ok( $accept, 'preferences' );
can_ok( $accept, 'media_types' );

sub is_match
{
    my( $hdr, $supported, $expect, $name ) = @_;
    my $ac = Apache2::API::Headers::Accept->new( $hdr, debug => $DEBUG );
    my $got = $ac->match( $supported );
    is( $got, $expect, $name );
}

is( $accept->header, 'text/html, application/json;q=0.5', 'Header stored correctly' );

# Test preferences
my $prefs = $accept->preferences;
is_deeply( $prefs, ['text/html', 'application/json'], 'Preferences sorted by q descending' );

# Exact match beats broader ranges
is_match(
    'text/html, application/json;q=0.5',
    [ 'application/json', 'text/html' ],
    'text/html',
    'Exact match preferred by order + q'
);

# q-values: higher q wins
is_match(
    'text/html;q=0.5, application/json;q=0.9',
    [ 'text/html', 'application/json' ],
    'application/json',
    'Higher q wins'
);

# Test type wildcard
# type/* wins over */* and specificity considered
is_match(
    'text/*;q=0.7, */*;q=0.2, application/json;q=0.9',
    [ 'image/png', 'application/json', 'text/html' ],
    'application/json',