view release on metacpan or  search on metacpan

t/08.accept_language.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 vars qw( $DEBUG );
    our $DEBUG = exists( $ENV{AUTHOR_TESTING} ) ? $ENV{AUTHOR_TESTING} : 0;
};

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

use strict;
use warnings;

my $al = Apache2::API::Headers::AcceptLanguage->new( 'en-GB, fr-FR;q=0.8', debug => $DEBUG );
isa_ok( $al, 'Apache2::API::Headers::AcceptLanguage' );

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

sub is_match
{
    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'
);

# Primary language partial match
is_match(
    'en;q=0.5, fr-FR;q=0.9',
    [ 'en-GB', 'fr-FR' ],
    'fr-FR',
    'Higher q exact vs partial language match'
);

# Primary language matches more specific server locale