Apache2-API

 view release on metacpan or  search on metacpan

lib/Apache2/API/Headers/Accept.pm  view on Meta::CPAN

=head1 NAME

Apache2::API::Headers::Accept - Parser and matcher for HTTP Accept header

=head1 SYNOPSIS

    use Apache2::API::Headers::Accept;
    my $accept = Apache2::API::Headers::Accept->new('text/html;q=0.9,application/json');
    my $mime = $accept->match(['text/html', 'application/json']); # => 'text/html'
    # inspect client preferences (by q, desc):
    my $prefs = $a->preferences; # [ 'application/json', 'text/html' ]

=head1 DESCRIPTION

Parses the C<Accept> header and selects the best media type among the types you can serve. It supports exact matches (C<type/subtype>), type wildcards (C<type/*>), and full wildcards (C<*/*>), with quality values (C<q>) per RFC 7231 and RFC 9110.

It inherits from L<Apache2::API::Headers::AcceptCommon>.

The algorithm is as follows:

=over 4

lib/Apache2/API/Headers/AcceptCommon.pm  view on Meta::CPAN

    $self->SUPER::init( @_ ) || return( $self->pass_error );
    my $parsed = [];
    if( defined( $header ) && length( $header ) )
    {
        $parsed = $self->_parse( $header ) || return( $self->pass_error );
    }
    $self->{header} = $header;
    $self->{parsed_header}  = $parsed;
    # Cache
    $self->{_sorted} = undef;
    $self->{_prefs}  = undef;
    return( $self );
}

# Read-only
sub header { return( shift->_set_get_scalar( 'header' ) ); }

# Returns an empty string if no match, and undef upon error with the error object accessible with the 'error' method inherited from Module::Generic
sub match
{
    my $self = shift( @_ );

lib/Apache2/API/Headers/AcceptCommon.pm  view on Meta::CPAN

        }
        return( $best_match );
    }
}

sub preferences
{
    my $self = shift( @_ );

    # Cached
    return( [@{$self->{_prefs}}] ) if( $self->{_prefs} );

    my @pref = map{ $_->{token} } @{$self->_sorted};
    $self->{_prefs} = \@pref;
    # For safety, we return a copy
    return( [@pref] );
}

# Abstract – must be overridden by subclasses.
sub _full_match
{
    die( ref( $_[0] ) . "::_full_match() not implemented\n" );
}

lib/Apache2/API/Headers/AcceptCommon.pm  view on Meta::CPAN

=head2 preferences

Read-only.

Returns an array reference of the client tokens, sorted by decreasing quality weight (C<q>) as submitted upon the HTTP request, with duplicates removed (keeping highest C<q>). Always returns an array reference (even when cached).

So, for example:

    my $accept = Apache2::API::Headers::Accept->new( 'text/html;q=0.9,application/json' );
    my $prefs  = $accept->preferences; # ['application/json', 'text/html']

If an error occurred, it sets an error that can be retrieved with the L<error method|Module::Generic/error>, and it returns C<undef> in scalar context, or an empty list in list context.

=head1 MATCH PRIORITY MODE

Two policies are supported for tie-breaking when several tokens have the same C<q>. You can choose per subclass:

=over 4

=item * Modern (default): tie favors header order (client’s order) and specificity.

lib/Apache2/API/Headers/AcceptLanguage.pm  view on Meta::CPAN

=head1 NAME

Apache2::API::Headers::AcceptLanguage - Parser and matcher for HTTP Accept-Language header

=head1 SYNOPSIS

    use Apache2::API::Headers::AcceptLanguage;
    my $al = Apache2::API::Headers::AcceptLanguage->new( 'fr-FR;q=0.9,en;q=0.8' );
    my $locale = $al->match( ['en', 'fr-FR'] ); # => 'fr-FR'
    my $prefs = $al->prefs; # => ['fr-FR', 'en']

=head1 DESCRIPTION

Parses HTTP C<Accept-Language> header and provides the L<Apache2::API::Headers::AcceptCommon/match> method to match against supported locales (languages).

Full tag matches (e.g. C<fr-FR>) trump primary-language matches (e.g. C<fr> matching C<fr-CA>), with quality values (C<q>) per RFC 7231 and RFC 9110. Language/locale parsing is done with L<Locale::Unicode>.

It inherits from L<Apache2::API::Headers::AcceptCommon>.

The algorithm is as follows:

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

{
    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

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

            $ac->match( [ 'image/png', 'text/html', 'application/json' ] ),
            'image/png',
            'Higher q wildcard chooses first supported'
        );
    }
};

subtest 'preferences consistency' => sub
{
    my $ac = Apache2::API::Headers::Accept->new( 'text/plain;q=0.4, text/html;q=0.9, application/json', debug => $DEBUG );
    my $prefs = $ac->preferences;
    isa_ok( $prefs, 'ARRAY', 'Accept::preferences returns arrayref (first call)' );
    my $prefs2 = $ac->preferences;
    isa_ok( $prefs2, 'ARRAY', 'Accept::preferences returns arrayref (cached path)' );
    is_deeply( $prefs2, $prefs, 'Accept::preferences cached == initial' );
};

subtest 'mismatch priority mode' => sub
{
    # In legacy mode, at equal q, priority follows the OFFER list rather than header order.
    {
        local $Apache2::API::Headers::Accept::MATCH_PRIORITY_0_01_STYLE = 1;
        my $ac = Apache2::API::Headers::Accept->new( 'text/html;q=0.8, application/json;q=0.8', debug => $DEBUG );
        is(
            $ac->match( [ 'application/json', 'text/html' ] ),

t/08.accept_language.t  view on Meta::CPAN

{
    my( $hdr, $offers, $expect, $name ) = @_;
    my $al = Apache2::API::Headers::AcceptLanguage->new( $hdr, debug => $DEBUG );
    my $got = $al->match( $offers );
    is( $got, $expect, $name );
}

is( $al->header, 'en-GB, fr-FR;q=0.8', 'Header stored correctly' );

# Test preferences (locales)
my $prefs = $al->preferences;
is_deeply( $prefs, ['en-GB', 'fr-FR'], 'Preferences sorted by q descending' );

# Test aliases
is_deeply( $al->languages, $prefs, 'languages alias' );
is_deeply( $al->locales, $prefs, 'locales alias' );


# Exact tag match
is_match(
    'en-GB, fr-FR;q=0.8',
    [ 'fr-FR', 'en-GB' ],
    'en-GB',
    'Exact locale match'
);

t/08.accept_language.t  view on Meta::CPAN

    is( $al->match(['fr', 'en']), 'fr', '0.01 style: supported order' );

    # Test complex locale
    $al = Apache2::API::Headers::AcceptLanguage->new('ja-Kana-t-it;q=0.9', debug => $DEBUG);
    is( $al->preferences->[0], 'ja-Kana-t-it', 'Complex locale parsed' );
};

subtest 'preferences consistency' => sub
{
    $al = Apache2::API::Headers::AcceptLanguage->new( 'fr-FR;q=0.5, en-GB;q=0.8, fr;q=0.7', debug => $DEBUG );
    my $prefs = $al->preferences;
    isa_ok( $prefs, 'ARRAY', 'AcceptLanguage::preferences returns arrayref (first call)' );
    my $prefs2 = $al->preferences;
    isa_ok( $prefs2, 'ARRAY', 'AcceptLanguage::preferences returns arrayref (cached path)' );
    is_deeply( $prefs2, $prefs, 'AcceptLanguage::preferences cached == initial' );
};


done_testing();

__END__