view release on metacpan or  search on metacpan

lib/CGI/Lingua.pm  view on Meta::CPAN

package CGI::Lingua;

use warnings;
use strict;
use autodie qw(:all);

use Carp qw(croak carp);
use Object::Configure 0.23;
use Params::Get 0.15;	# 0.15 fast-path: unblessed hashref returned directly
use Readonly;
use Scalar::Util qw(blessed);
use JSON::PP ();
use Class::Autouse qw{
	Locale::Language
	Locale::Object::Country
	Locale::Object::DB
	I18N::AcceptLanguage
	I18N::LangTags::Detect
};

our $VERSION = '0.85';

# ── Module-level constants ───────────────────────────────────────────────────
# Gathering magic strings here makes behavioural changes one-edit operations.

Readonly my $CACHE_TTL_LONG      => '1 month';
Readonly my $CACHE_TTL_SHORT     => '1 hour';
Readonly my $CACHE_NS            => 'CGI::Lingua:';    # namespace prefix for every key
Readonly my $BROKEN_GEOIPFREE    => '45.128.139.41';  # https://github.com/bricas/geo-ipfree/issues/10
Readonly my $BAIDU_SUBNET        => '185.10.104.0/22';# RT-86809: Baidu misreports as EU
Readonly my $DEPRECATED_EN_UK    => 'en-uk';          # some browsers still send this
Readonly my $CANONICAL_EN_GB     => 'en-gb';
Readonly my $ACCEPT_LANG_MAX     => 256;              # max bytes we accept from the header
Readonly my $UA_MAX              => 512;              # max bytes we accept from HTTP_USER_AGENT
Readonly my $GEO_UNKNOWN         => -1;               # geo-module sentinel: not yet probed
Readonly my $GEO_ABSENT          =>  0;               # geo-module sentinel: unavailable
Readonly my $GEO_PRESENT         =>  1;               # geo-module sentinel: loaded OK

# Package-level sentinel for Locale::Object's SQLite database.  undef = not yet
# probed; 0 = database absent (Windows installers often omit it); 1 = available.
# Package-level (not per-object) because the database either exists on the
# filesystem or it doesn't — there is no per-request variability.
my $_locale_object_db_ok;

# Package-level sentinel for Data::Validate::IP / NetAddr::IP availability.
# NetAddr::IP::UtilPP fails to build on Windows (mask4to6 bad-argument error),
# which cascades to Data::Validate::IP.  undef = not yet probed; 0 = broken;
# 1 = available.  On first country() call we try to load the module and, if it
# fails, install pure-Perl aliases for the four functions we use.
my $_have_dvip;

# Short-name overrides used when Locale::Object's database is absent and we
# fall back to Locale::Codes::Country.  Locale::Codes carries full ISO official
# names (e.g. "United Kingdom of Great Britain and Northern Ireland") while
# Locale::Object returns the common short form ("United Kingdom").  Only
# entries that differ are listed; everything else comes from Locale::Codes.
my %COUNTRY_SHORT_NAMES = (
	bo => 'Bolivia',
	cd => 'Democratic Republic of the Congo',
	fk => 'Falkland Islands',
	fm => 'Micronesia',
	gb => 'United Kingdom',
	ir => 'Iran',
	kp => 'North Korea',
	kr => 'South Korea',
	md => 'Moldova',
	nl => 'Netherlands',
	ps => 'Palestine',
	tw => 'Taiwan',
	tz => 'Tanzania',
	us => 'United States',
	ve => 'Venezuela',
);

Readonly my %RTL_LANGS           => (map { $_ => 1 }  # ISO 639-1 codes whose primary script is RTL
	qw(ar dv fa he ku ps sd ug ur yi));

=head1 NAME

CGI::Lingua - Create a multilingual web page

=head1 VERSION

Version 0.85

=cut

=head1 SYNOPSIS

CGI::Lingua is a powerful module for multilingual web applications
offering extensive language/country detection strategies.

No longer does your website need to be in English only.
CGI::Lingua provides a simple basis to determine which language to display a website.
The website tells CGI::Lingua which languages it supports.
Based on that list CGI::Lingua tells the application which language the user would like to use.

    use CGI::Lingua;
    # ...
    my $l = CGI::Lingua->new(['en', 'fr', 'en-gb', 'en-us']);
    my $language = $l->language();
    if ($language eq 'English') {
	print '<P>Hello</P>';
    } elsif($language eq 'French') {
	print '<P>Bonjour</P>';
    } else {	# $language eq 'Unknown'
	my $rl = $l->requested_language();