CGI-Lingua
view release on metacpan or search on metacpan
Allow arguments to new() to be hash or hashref
0.48 Wed Jan 30 14:12:01 EST 2013
Fixed t/eu.t which gave false negatives on systems with Geo::IP
installed
Added CloudFlare optimisation to country()
0.47 Sat Jan 19 09:21:56 EST 2013
Handle en-029
Remove t/unused.t - now use t/vars.t
Handle unknown country EU in locale(). Beefed up t/eu.t
0.46 Sun Dec 30 11:07:15 EST 2012
Handle uninitialised variable in country()
Added t/strict.t
0.45 Thu Dec 6 08:33:12 EST 2012
Fixed t/eu.t on systems with Geo::IP
0.44 Mon Dec 3 08:47:12 EST 2012
Fixed t/unused.t for Windows - removed unneeded dependency
0.39 Fri Jul 13 09:44:11 BST 2012
Use mod_geoip as a fall back if it is installed
Fixed unitialized variable in test
Better handling of automatic build environments
0.38 Sat Jun 2 15:23:40 EDT 2012
Fix use of unitialised variable
Handle remote address '::1' (IPv6)
Added test for RT77332
locale(): better handling of whois failure
Handle case where Whois entry consists only of a newline
0.37 Tue May 15 14:37:47 EDT 2012
Fix strange sublanguage handling when
'HTTP_ACCEPT_LANGUAGE = 'en-gb,en;q=0.5,x-ns1Gcc7A8xaNx1,x-ns294eMxcVGQb2'
0.36 Sat May 12 09:04:04 EDT 2012
Catch connection timeouts to whois.apnic.net
0.35 Thu May 3 10:17:04 BST 2012
0.28 Thu Oct 6 13:44:20 EDT 2011
Improved handling of connection failure to whois.arin.net
Fix the argument to syslog
Try to avoid the Carp call within Locale::Object::Country
0.27 Mon Sep 19 15:07:58 EDT 2011
Improved handling
Added syslog argument to new
0.26 Fri Sep 9 11:13:02 EDT 2011
Added some tests and clarified the locale() documentation
Added subcountry_code_alpha2()
0.25 Tue Sep 6 13:08:06 EDT 2011
Only call HTTP::BrowserDetect if we're in a CGI environment
0.24 Sun Sep 4 08:53:50 EDT 2011
locale now falls back to HTTP::BrowserDetect if it's present
0.23 Fri Aug 26 13:19:51 EDT 2011
Added t/critic.t
Correct documentation about what class is returned by locale()
0.22 Wed Aug 10 13:46:42 EDT 2011
Fixed unitialised variable in some circumstances when checking language
0.21 Wed Jul 20 13:39:57 EDT 2011
Added locale method
Had another go at returning sensible values if a requested
sublanguage can't be honoured
Added test for RT69509
0.20 Fixed some 'Can't call method "name" on an undefined value' when the
browser suggests more than one language and a requested
sublanguage isn't available
0.19 More sensible choice of real world language requirements, for example
a browser requesting US English on a site that only delivers
t/es_419.t
t/eu.t
t/fuzz.t
t/gv.t
t/hk.t
t/hp-tablet.t
t/kwalitee.t
t/language.t
t/lib/MyLogger.pm
t/links.t
t/locale.t
t/logger.t
t/manifest.t
t/metrics.t
t/modules-used.t
t/no404s.t
t/noopentickets.t
t/noplan.t
t/pod-cm.t
t/pod-snippets.t
t/pod-spelling.t
my $l = CGI::Lingua->new(supported => ['en', 'fr', 'en-gb']);
If the browser requests 'en-us', then language will be 'English' and
sublanguage will also be undefined, which may seem strange, but it
ensures that sites behave sensibly.
# Site supports British English only
my $l = CGI::Lingua->new({ supported => ['fr', 'en-gb']} );
If the script is not being run in a CGI environment, perhaps to debug it, the
locale is used via the LANG environment variable.
## preferred\_language
Same as language().
## name
Synonym for language, for compatibility with Local::Object::Language
## sublanguage
## country
Returns the two-character country code of the remote end in lowercase.
If [IP::Country](https://metacpan.org/pod/IP%3A%3ACountry), [Geo::IPfree](https://metacpan.org/pod/Geo%3A%3AIPfree) or [Geo::IP](https://metacpan.org/pod/Geo%3A%3AIP) is installed,
CGI::Lingua will make use of that, otherwise, it will do a Whois lookup.
If you do not have any of those installed I recommend you use the
caching capability of CGI::Lingua.
## locale
HTTP doesn't have a way of transmitting a browser's localisation information
which would be useful for default currency, date formatting, etc.
This method attempts to detect the information, but it is a best guess
and is not 100% reliable. But it's better than nothing ;-)
Returns a [Locale::Object::Country](https://metacpan.org/pod/Locale%3A%3AObject%3A%3ACountry) object.
To be clear, if you're in the US and request the language in Spanish,
and the site supports it, language() will return 'Spanish', and locale() will
try to return the Locale::Object::Country for the US.
## time\_zone
Returns the timezone of the web client.
If [Geo::IP](https://metacpan.org/pod/Geo%3A%3AIP) is installed,
CGI::Lingua will make use of that, otherwise it will use [ip-api.com](https://metacpan.org/pod/ip-api.com)
# AUTHOR
lib/CGI/Lingua.pm view on Meta::CPAN
%{$params},
_supported => ref($params->{supported}) ? $params->{supported} : [ $params->{'supported'} ], # List of languages (two letters) that the application
_cache => $cache, # CHI
_info => $info,
# _rlanguage => undef, # Requested language
# _slanguage => undef, # Language that the website should display
# _sublanguage => undef, # E.g. United States for en-US if you want American English
# _slanguage_code_alpha2 => undef, # E.g en, fr
# _sublanguage_code_alpha2 => undef, # E.g. us, gb
# _country => undef, # Two letters, e.g. gb
# _locale => undef, # Locale::Object::Country
_syslog => $params->{syslog},
_dont_use_ip => $params->{dont_use_ip} || 0,
_have_ipcountry => -1, # -1 = don't know
_have_geoip => -1, # -1 = don't know
_have_geoipfree => -1, # -1 = don't know
_debug => $params->{debug} || 0,
}, $class;
}
# Some of the information takes a long time to work out, so cache what we can
lib/CGI/Lingua.pm view on Meta::CPAN
my $l = CGI::Lingua->new(supported => ['en', 'fr', 'en-gb']);
If the browser requests 'en-us', then language will be 'English' and
sublanguage will also be undefined, which may seem strange, but it
ensures that sites behave sensibly.
# Site supports British English only
my $l = CGI::Lingua->new({ supported => ['fr', 'en-gb']} );
If the script is not being run in a CGI environment, perhaps to debug it, the
locale is used via the LANG environment variable.
=cut
sub language {
my $self = $_[0];
unless($self->{_slanguage}) {
$self->_find_language();
}
return $self->{_slanguage};
lib/CGI/Lingua.pm view on Meta::CPAN
$self->{_geoip} = Geo::IP->new(0);
}
} else {
$self->{_have_geoip} = 0;
}
} else {
$self->{_have_geoip} = 0;
}
}
=head2 locale
HTTP doesn't have a way of transmitting a browser's localisation information
which would be useful for default currency, date formatting, etc.
This method attempts to detect the information, but it is a best guess
and is not 100% reliable. But it's better than nothing ;-)
Returns a L<Locale::Object::Country> object.
To be clear, if you're in the US and request the language in Spanish,
and the site supports it, language() will return 'Spanish', and locale() will
try to return the Locale::Object::Country for the US.
=cut
sub locale {
my $self = shift;
if($self->{_locale}) {
return $self->{_locale};
}
# First try from the User Agent. Probably only works with Mozilla and
# Safari. I don't know about Opera. It won't work with IE or Chrome.
my $agent = $ENV{'HTTP_USER_AGENT'};
my $country;
if(defined($agent) && ($agent =~ /\((.+)\)/)) {
foreach(split(/;/, $1)) {
my $candidate = $_;
$candidate =~ s/^\s//g;
$candidate =~ s/\s$//g;
if($candidate =~ /^[a-zA-Z]{2}-([a-zA-Z]{2})$/) {
local $SIG{__WARN__} = undef;
if(my $c = $self->_code2country($1)) {
$self->{_locale} = $c;
return $c;
}
# carp "Warning: unknown country $1 derived from $candidate in HTTP_USER_AGENT ($agent)";
}
}
if(eval { require HTTP::BrowserDetect; } ) {
HTTP::BrowserDetect->import();
my $browser = HTTP::BrowserDetect->new($agent);
if($browser && $browser->country() && (my $c = $self->_code2country($browser->country()))) {
$self->{_locale} = $c;
return $c;
}
}
}
# Try from the IP address
$country = $self->country();
if($country) {
$country =~ s/[\r\n]//g;
my $c;
eval {
local $SIG{__WARN__} = sub { die $_[0] };
$c = $self->_code2country($country);
};
unless($@) {
if($c) {
$self->{_locale} = $c;
return $c;
}
}
}
# Try mod_geoip
if(defined($ENV{'GEOIP_COUNTRY_CODE'})) {
$country = $ENV{'GEOIP_COUNTRY_CODE'};
my $c = $self->_code2country($country);
if($c) {
$self->{_locale} = $c;
return $c;
}
}
return undef;
}
=head2 time_zone
Returns the timezone of the web client.
t/30-basics.t view on Meta::CPAN
$mock_country->mock('code_alpha2', sub { 'MC' });
# Locale from Locale::Object::Country
subtest 'From User-Agent' => sub {
local %ENV = (
%{$mock_env},
HTTP_USER_AGENT => 'Mozilla/5.0 (X11; Linux x86_64; rv:91.0) en-US'
);
my $lingua = CGI::Lingua->new(supported => ['en']);
my $locale = $lingua->locale();
isa_ok($locale, 'Locale::Object::Country', 'Locale object');
is($locale->code_alpha2(), 'MC', 'Correct country from Locale::Object::Country');
};
# Invalid country code
subtest 'Invalid Code' => sub {
local %ENV = %{$mock_env};
$ENV{GEOIP_COUNTRY_CODE} = 'XX';
# Mock _code2country to return our mock country object
my $mock_lingua = Test::MockModule->new('CGI::Lingua');
$mock_lingua->mock('_code2country', sub {
my ($self, $code) = @_;
return bless { code => lc $code }, 'Locale::Object::Country';
});
my $lingua = CGI::Lingua->new(supported => ['en']);
$mock_lingua->mock('_code2country', sub { undef });
ok(!defined $lingua->locale(), 'Undefined for invalid country code');
};
Test::MockModule->unmock_all();
};
subtest 'IPv6 Handling' => sub {
my $ipv6_public = '2001:db8::1'; # Test documentation IP
my $ipv6_private = 'fd00::1'; # ULA private IP
my $ipv6_loopback = '::1';
my $ipv6_v4mapped = '::ffff:192.0.2.1';
t/40-more.t view on Meta::CPAN
$obj = CGI::Lingua->new(supported => ['en']);
like $obj->country, qr/^[a-z]{2}$/, 'Country returns valid code for public IP';
$obj = CGI::Lingua->new(supported => ['en-gb']);
$ENV{REMOTE_ADDR} = '192.168.1.1';
is $obj->country, undef, 'Country returns undef for private IP';
$ENV{REMOTE_ADDR} = '::1';
is $obj->country, undef, 'Country returns undef for IPv6 loopback';
# Test locale and time_zone methods
$ENV{REMOTE_ADDR} = '8.8.8.8';
$obj = CGI::Lingua->new(supported => ['en']);
isa_ok $obj->locale, 'Locale::Object::Country', 'Locale returns country object';
like $obj->time_zone, qr/.+/, 'Time zone returns string';
# Test DESTROY method
{
my $cache = CHI->new(driver => 'Memory', global => 1);
my $obj = CGI::Lingua->new(supported => ['en'], cache => $cache);
$ENV{REMOTE_ADDR} = '192.168.1.1';
}
pass 'DESTROY called without errors';
skip 'FIXME: find another EU IP address', 6 if(defined($l->country()) && ($l->country() eq 'ke'));
skip 'FIXME: find another EU IP address', 6 if(defined($l->country()) && ($l->country() eq 'nl'));
ok(defined($l->country()));
ok($l->country() eq 'Unknown');
ok($l->language_code_alpha2() eq 'en');
ok($l->language() eq 'English');
ok(defined($l->requested_language()));
ok($l->requested_language() eq 'English');
}
ok(!defined($l->sublanguage()));
# diag($l->locale());
}
#!perl -Tw
use strict;
use warnings;
use Test::More;
use CGI::Lingua;
# use Test::NoWarnings; # Win32::locale::Lexicon produces warnings
# Work around for systems with broken Module::Load
# http://www.cpantesters.org/cpan/report/eae7b808-172d-11e0-a672-41e7f2486b6f
use Test::Requires {
'Module::Load::Conditional' => 0.38
};
unless(-e 't/online.enabled') {
plan skip_all => 'On-line tests disabled';
} else {
t/hp-tablet.t view on Meta::CPAN
$ENV{'HTTP_USER_AGENT'} = 'Mozilla/5.0 (hp-tablet; Linux; hpwOS/3.0.2; U; en-NZ) AppleWebKit/534.6 (KHTML, like Gecko) wOSBrowser/234.40.1 Safari/534.6 TouchPad/1.0';
my $l = new_ok('CGI::Lingua' => [
supported => [ 'en-gb', 'da', 'fr', 'nl', 'de', 'it', 'cy', 'pt', 'pl', 'ja' ],
]);
ok(defined $l);
ok($l->isa('CGI::Lingua'));
TODO: {
local $TODO = 'https://github.com/oalders/http-browserdetect/issues/36';
ok(defined($l->code_alpha2()));
isa_ok($l->locale(), 'Locale::Object::Country');
SKIP: {
skip 'Test requires Internet access', 1 unless(-e 't/online.enabled');
ok(uc($l->locale()->code_alpha2()) eq 'NZ');
}
}
}
t/language.t view on Meta::CPAN
if($l->language() ne 'English') {
diag('Expected English got "', $l->requested_language(), '"');
}
ok($l->name() eq 'English');
ok(defined $l->requested_language());
if($l->requested_language() !~ /English/) {
diag('Expected English requested language, got "', $l->requested_language(), '"');
}
ok($l->requested_language() =~ /English/);
ok($l->country() eq 'gb');
ok($l->locale()->code_alpha2() eq 'gb');
delete($ENV{'REMOTE_ADDR'});
$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'en';
$l = new_ok('CGI::Lingua' => [
supported => ['en', 'en-gb', 'fr']
]);
ok($l->language() eq 'English');
ok(defined($l->requested_language()));
ok($l->requested_language() eq 'English');
ok(!defined($l->sublanguage()));
t/language.t view on Meta::CPAN
ok(defined $l);
ok($l->isa('CGI::Lingua'));
ok($l->language() eq 'Unknown');
ok(defined($l->requested_language()));
ok(!defined($l->language_code_alpha2()));
ok(!defined($l->sublanguage_code_alpha2()));
ok($l->country() eq 'no');
if($l->country() ne 'no') {
diag('Expected no got "', $l->country(), '"');
}
ok($l->locale()->code_alpha2() eq 'no');
delete($ENV{'HTTP_ACCEPT_LANGUAGE'});
{
delete local $ENV{'GEOIP_COUNTRY_CODE'};
delete local $ENV{'HTTP_CF_IPCOUNTRY'};
local $ENV{'REMOTE_ADDR'} = 'a.b.c.d';
$l = new_ok('CGI::Lingua' => [
supported => ['en', 'fr'],
]);
# Force the logger, in case a logger is defined in a config file that Config::Abstraction reads
if($^O eq 'MSWin32') {
$ENV{'IGNORE_WIN32_LOCALE'} = 1;
}
delete $ENV{'HTTP_ACCEPT_LANGUAGE'};
delete $ENV{'REMOTE_ADDR'};
$ENV{'HTTP_USER_AGENT'} = 'Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10.6; en-US; rv:1.9.2.19) Gecko/20110707 Firefox/3.6.19';
my $l = new_ok('CGI::Lingua' => [
supported => ['en', 'en-us']
]);
ok(defined($l->locale()));
ok(defined($l->locale()->currency()));
ok($l->locale()->currency()->code() eq 'USD');
$ENV{'REMOTE_ADDR'} = '212.159.106.41';
$ENV{'HTTP_USER_AGENT'} = 'Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 5.1; Trident/4.0; .NET CLR 1.0.3705; .NET CLR 1.1.4322; Media Center PC 4.0; .NET CLR 2.0.50727; .NET CLR 3.0.4506.2152; .NET CLR 3.5.30729; .NET4.0C; .NET4.0E)';
$l = new_ok('CGI::Lingua' => [
supported => ['en', 'en-gb']
]);
ok(defined($l->locale()));
isa_ok($l->locale(), 'Locale::Object::Country');
ok($l->locale()->currency()->code() eq 'GBP');
ok(uc($l->locale()->code_alpha2()) eq 'GB');
my @l = $l->locale()->languages_official();
ok(uc($l[0]->code_alpha2()) eq 'EN');
ok(uc($l->locale()->code_alpha2()) eq 'GB');
delete $ENV{'REMOTE_ADDR'};
$ENV{'HTTP_USER_AGENT'} = 'Java';
$l = new_ok('CGI::Lingua' => [
supported => ['en', 'en-us']
]);
ok(!defined($l->locale()));
# Asking for French in the US should return US locale
$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'fr';
$ENV{'REMOTE_ADDR'} = '74.92.149.57';
$ENV{'HTTP_USER_AGENT'} = 'Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10.7; en-US; rv:1.9.2.22) Gecko/20110902 Firefox/3.6.22';
$l = new_ok('CGI::Lingua' => [
supported => ['en', 'nl', 'fr', 'de', 'id', 'il', 'ja', 'ko', 'pt', 'ru', 'es', 'tr']
]);
ok(defined($l->locale()));
isa_ok($l->locale(), 'Locale::Object::Country');
ok(uc($l->locale()->code_alpha2()) eq 'US');
ok(defined($l->locale()->currency()));
ok($l->locale()->currency()->code() eq 'USD');
# User agent doesn't contain a location
$ENV{'REMOTE_ADDR'} = '81.145.173.18';
$ENV{'HTTP_USER_AGENT'} = 'Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 5.2; WOW64; Trident/4.0; .NET CLR 1.1.4322; .NET CLR 2.0.50727; .NET CLR 3.0.04506.30; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; MS-RTC LM 8; .NET CLR 3.0.4506.2152; .NET CLR...
$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'en-gb';
$l = new_ok('CGI::Lingua' => [
supported => ['en', 'en-gb']
]);
ok(defined($l->locale()));
isa_ok($l->locale(), 'Locale::Object::Country');
ok($l->locale()->currency()->code() eq 'GBP');
ok(uc($l->locale()->code_alpha2()) eq 'GB');
@l = $l->locale()->languages_official();
ok(uc($l[0]->code_alpha2()) eq 'EN');
ok(uc($l->locale()->code_alpha2()) eq 'GB');
$ENV{'HTTP_USER_AGENT'} = 'foo';
$l = new_ok('CGI::Lingua' => [
supported => ['en', 'en-gb']
]);
ok(defined($l->locale()));
isa_ok($l->locale(), 'Locale::Object::Country');
ok($l->locale()->currency()->code() eq 'GBP');
ok(uc($l->locale()->code_alpha2()) eq 'GB');
@l = $l->locale()->languages_official();
ok(uc($l[0]->code_alpha2()) eq 'EN');
ok(uc($l->locale()->code_alpha2()) eq 'GB');
$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'en-us';
$ENV{'REMOTE_ADDR'} = '81.158.123.118';
$ENV{'HTTP_USER_AGENT'} = 'Mozilla/5.0 (Macintosh; Intel Mac OS X 10_7_3) AppleWebKit/534.55.3 (KHTML, like Gecko) Version/5.1.5 Safari/534.55.3';
$l = new_ok('CGI::Lingua' => [
supported => [ 'en-gb', 'da', 'fr', 'nl', 'de', 'it', 'cy', 'pt', 'pl', 'ja' ],
]);
my $locale = $l->locale();
isa_ok($locale, 'Locale::Object::Country');
ok(uc($l->locale()->code_alpha2()) eq 'GB');
$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'en-ca';
$ENV{'REMOTE_ADDR'} = '67.193.26.102';
$ENV{'HTTP_USER_AGENT'} = 'Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 5.1; Trident/4.0; GTB7.3; .NET CLR 1.1.4322; .NET CLR 2.0.50727; .NET CLR 3.0.04506.30; .NET CLR 3.0.4506.2152; .NET CLR 3.5.30729; .NET4.0C; .NET4.0E)';
$l = new_ok('CGI::Lingua' => [
supported => [ 'en-gb' ]
]);
$locale = $l->locale();
isa_ok($locale, 'Locale::Object::Country');
ok(uc($l->locale()->code_alpha2()) eq 'CA');
# LAN address
$ENV{'REMOTE_ADDR'} = '192.168.1.2';
$l = new_ok('CGI::Lingua' => [
supported => [ 'en-gb' ]
]);
ok(!defined($l->locale()));
# Find nothing
delete $ENV{'REMOTE_ADDR'};
$l = new_ok('CGI::Lingua' => [
supported => [ 'en-gb', 'da', 'fr', 'nl', 'de', 'it', 'cy', 'pt', 'pl', 'ja' ],
]);
$locale = $l->locale();
ok(!defined($locale));
# Add GEOIP_COUNTRY_CODE and now something should be found
$ENV{'GEOIP_COUNTRY_CODE'} = 'GB';
$l = new_ok('CGI::Lingua' => [
supported => [ 'en-gb', 'da', 'fr', 'nl', 'de', 'it', 'cy', 'pt', 'pl', 'ja' ],
]);
$locale = $l->locale();
isa_ok($locale, 'Locale::Object::Country');
ok(uc($l->locale()->code_alpha2()) eq 'GB');
} else {
plan skip_all => 'On-line tests disabled';
}
t/rt86809.t view on Meta::CPAN
#!perl -Tw
# Sometimes IANA reports 185.10.104.194 as being in NL rather than in Hong Kong
use strict;
use warnings;
use Test::Most;
# use Test::NoWarnings; # Win32::locale::Lexicon produces warnings
use lib 't/lib';
use MyLogger;
eval 'use autodie qw(:all)'; # Test for open/close failures
# Work around for systems with broken Module::Load
# http://www.cpantesters.org/cpan/report/eae7b808-172d-11e0-a672-41e7f2486b6f
use Test::Requires {
'Module::Load::Conditional' => 0.38
};
$ENV{'REMOTE_ADDR'} = '95.147.222.177';
my $l = new_ok('CGI::Lingua' => [
supported => ['en-gb', 'da', 'fr', 'nl', 'de', 'it', 'cy', 'pt', 'pl', 'ja'],
cache => $cache
]);
ok(defined $l);
ok($l->isa('CGI::Lingua'));
SKIP: {
skip 'Test requires Internet access', 2 unless(-e 't/online.enabled');
ok($l->country() eq 'gb');
ok($l->locale()->code_alpha2() eq 'gb');
}
ok(defined($l->requested_language()));
cmp_ok($l->requested_language(), 'eq', 'English (United Kingdom)');
ok($l->language() eq 'English');
ok($l->sublanguage() eq 'United Kingdom');
ok($l->sublanguage_code_alpha2() eq 'gb');
$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'en-GB';
$l = new_ok('CGI::Lingua' => [
supported => ['en-gb', 'da', 'fr', 'nl', 'de', 'it', 'cy', 'pt', 'pl', 'ja'],
cache => $cache
]);
ok(defined $l);
ok($l->isa('CGI::Lingua'));
SKIP: {
skip 'Test requires Internet access', 2 unless(-e 't/online.enabled');
ok($l->country() eq 'gb');
ok($l->locale()->code_alpha2() eq 'gb');
}
ok(defined($l->requested_language()));
ok($l->requested_language() eq 'English (United Kingdom)');
ok($l->language() eq 'English');
ok($l->sublanguage() eq 'United Kingdom');
$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'en-US';
$l = new_ok('CGI::Lingua' => [
supported => ['en-us', 'da', 'fr', 'nl', 'de', 'it', 'cy', 'pt', 'pl', 'ja'],
cache => $cache
]);
ok(defined $l);
ok($l->isa('CGI::Lingua'));
SKIP: {
skip 'Test requires Internet access', 2 unless(-e 't/online.enabled');
ok($l->country() eq 'gb');
ok($l->locale()->code_alpha2() eq 'gb');
}
ok(defined($l->requested_language()));
ok($l->requested_language() eq 'English (United States)');
ok($l->language() eq 'English');
ok($l->sublanguage() eq 'United States');
$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'en';
$l = new_ok('CGI::Lingua' => [
supported => ['en-gb', 'da', 'fr', 'nl', 'de', 'it', 'cy', 'pt', 'pl', 'ja'],
cache => $cache
]);
ok(defined $l);
ok($l->isa('CGI::Lingua'));
SKIP: {
skip 'Test requires Internet access', 2 unless(-e 't/online.enabled');
ok($l->country() eq 'gb');
ok($l->locale()->code_alpha2() eq 'gb');
}
ok(defined($l->requested_language()));
ok($l->requested_language() eq 'English (United Kingdom)');
ok($l->language() eq 'English');
ok($l->sublanguage() eq 'United Kingdom');
$l = new_ok('CGI::Lingua' => [
supported => ['en', 'da', 'fr', 'nl', 'de', 'it', 'cy', 'pt', 'pl', 'ja'],
cache => $cache
]);
SKIP: {
skip 'Test requires Internet access', 2 unless(-e 't/online.enabled');
ok($l->country() eq 'gb');
ok($l->locale()->code_alpha2() eq 'gb');
}
ok(defined($l->requested_language()));
cmp_ok($l->requested_language(), 'eq', 'English', 'Requested language is English');
cmp_ok($l->language(), 'eq', 'English', 'Language is English');
ok(!defined($l->sublanguage()));
# We want US English, but only British English is served, return English
# but with no sublanguage support
$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'en-us';
$l = new_ok('CGI::Lingua' => [
supported => ['en-gb'],
cache => $cache
]);
ok(defined $l);
isa_ok($l, 'CGI::Lingua');
SKIP: {
skip 'Test requires Internet access', 2 unless(-e 't/online.enabled');
ok($l->country() eq 'gb');
ok($l->locale()->code_alpha2() eq 'gb');
}
ok(defined($l->requested_language()));
ok($l->requested_language() eq 'English (United States)');
ok($l->language() eq 'English');
ok(!defined($l->sublanguage()));
}
ok(!defined($l->language_code_alpha2()));
ok($l->language() eq 'Unknown');
ok($l->requested_language() eq 'Unknown');
} else {
ok($l->language_code_alpha2() eq 'en');
ok($l->language() eq 'English');
ok($l->requested_language() eq 'English');
}
}
ok(!defined($l->sublanguage()));
# diag($l->locale());
}
( run in 1.731 second using v1.01-cache-2.11-cpan-ceb78f64989 )