File Coverage

=head1 NAME

CGI::Lingua - Create a multilingual web page

=head1 VERSION

Version 0.84

=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();
        print "<P>Sorry for now this page is not available in $rl.</P>";
    }
    my $c = $l->country();
    if ($c eq 'us') {
      # print contact details in the US
    } elsif ($c eq 'ca') {
      # print contact details in Canada
    } else {
      # print worldwide contact details
    }

    # ...

    use CHI;
    use CGI::Lingua;
    # ...
    my $cache = CHI->new(driver => 'File', root_dir => '/tmp/cache', namespace => 'CGI::Lingua-countries');
    $l = CGI::Lingua->new({ supported => ['en', 'fr'], cache => $cache });

=head1 SUBROUTINES/METHODS

=head2 new

Creates a CGI::Lingua object.

=head3 API SPECIFICATION

    Input:
      supported  => ArrayRef[Str] | Str   # required; RFC-1766 language codes
      cache      => Object                # optional; CHI-compatible (get/set)
      config_file => Str                  # optional; YAML/XML/INI config path
      logger     => Object                # optional; must implement warn/info/error
      info       => Object                # optional; CGI::Info-compatible
      data       => Any                   # optional; forwarded to I18N::AcceptLanguage
      dont_use_ip => Bool                 # optional; disable IP-based fallback
      syslog     => Bool | HashRef        # optional; Sys::Syslog integration
      debug      => Bool                  # optional; enable debug logging

    Returns: CGI::Lingua blessed hashref, or a clone when called on an object.

=head3 EXAMPLE

    # Array-ref of supported codes (most common form)
    my $l = CGI::Lingua->new({ supported => ['en', 'fr', 'de'] });

    # Single scalar code
    my $l = CGI::Lingua->new(supported => 'en');

    # With cache, logger, and CGI::Info object
    use CHI;
    my $cache = CHI->new(driver => 'File', root_dir => '/tmp/lingua-cache');
    my $l = CGI::Lingua->new({
        supported => ['en', 'fr'],
        cache     => $cache,
        logger    => $my_log_object,
    });

    # Clone an existing object with different supported list
    my $clone = $l->new(supported => ['de']);

=head3 MESSAGES

    "You must give a list of supported languages"  - no 'supported' key provided
    "List of supported languages must be an array ref" - supported is wrong ref type
    "Supported languages must be the short code"  - string too short or too long
    "Logger must be a blessed object with warn/info/error methods" - bad logger arg

=head3 PSEUDOCODE

    1. Normalise args via Params::Get and Object::Configure
    2. Validate logger (must be blessed with warn/info/error) if provided
    3. Validate supported (required, string or arrayref)
    4. If cache and REMOTE_ADDR set, attempt to thaw a previously stored state
    5. Bless and return fresh object with sentinel flags set to GEO_UNKNOWN

=cut

=head2 language

Tells the CGI application in what language to display its messages.
The language is the natural name e.g. 'English' or 'Japanese'.

Sublanguages are handled sensibly, so that if a client requests U.S. English
on a site that only serves British English, language() will return 'English'.

If none of the requested languages is included within the supported lists,
language() returns 'Unknown'.

=head3 EXAMPLE

    local $ENV{HTTP_ACCEPT_LANGUAGE} = 'fr,en;q=0.9';
    my $l = CGI::Lingua->new(supported => ['en', 'fr']);
    print $l->language();   # "French"

=head3 API SPECIFICATION

    Input:  none beyond $self
    Returns: Str - human-readable language name, or 'Unknown'

=cut

=head2 preferred_language

Same as language().

=cut

=head2 name

Synonym for language, for compatibility with Locale::Object::Language.

=cut

=head2 sublanguage

Tells the CGI what variant to use e.g. 'United Kingdom', or undef if
it can't be determined.

=head3 EXAMPLE

    local $ENV{HTTP_ACCEPT_LANGUAGE} = 'en-gb';
    my $l = CGI::Lingua->new(supported => ['en-gb']);
    print $l->sublanguage();   # "United Kingdom"

=head3 API SPECIFICATION

    Input:  none beyond $self
    Returns: Str | undef

=cut

=head2 language_code_alpha2

Gives the two-character representation of the supported language, e.g. 'en'
when you've asked for en-gb.

If none of the requested languages is included within the supported lists,
language_code_alpha2() returns undef.

=head3 EXAMPLE

    local $ENV{HTTP_ACCEPT_LANGUAGE} = 'en-gb';
    my $l = CGI::Lingua->new(supported => ['en-gb']);
    print $l->language_code_alpha2();   # "en"

=head3 API SPECIFICATION

    Input:  none beyond $self
    Returns: Str (2 chars) | undef

=cut

=head2 code_alpha2

Synonym for language_code_alpha2, kept for historical reasons.

=cut

=head2 sublanguage_code_alpha2

Gives the two-character representation of the supported language, e.g. 'gb'
when you've asked for en-gb, or undef.

=head3 EXAMPLE

    local $ENV{HTTP_ACCEPT_LANGUAGE} = 'en-gb';
    my $l = CGI::Lingua->new(supported => ['en-gb']);
    print $l->sublanguage_code_alpha2();   # "gb"

=head3 API SPECIFICATION

    Input:  none beyond $self
    Returns: Str (2 chars) | undef

=cut

=head2 requested_language

Gives a human-readable rendition of what language the user asked for whether
or not it is supported.

Returns the sublanguage (if appropriate) in parentheses,
e.g. "English (United Kingdom)"

=head3 EXAMPLE

    local $ENV{HTTP_ACCEPT_LANGUAGE} = 'en-gb';
    my $l = CGI::Lingua->new(supported => ['en']);
    print $l->requested_language();   # "English (United Kingdom)"

=head3 API SPECIFICATION

    Input:  none beyond $self
    Returns: Str - e.g. "English (United Kingdom)" or "Unknown"

=cut

=head2 country

Returns the two-character country code of the remote end in lowercase.

If L<IP::Country>, L<Geo::IPfree> or L<Geo::IP> 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.

=head3 API SPECIFICATION

    Input:  none beyond $self
    Returns: Str (2 lowercase chars) | undef
      'Unknown' is only returned in the Baidu-EU special case via _handle_eu_country.

=head3 EXAMPLE

    # With mod_geoip (fastest - no IP lookup at all):
    local $ENV{GEOIP_COUNTRY_CODE} = 'DE';
    print $l->country();   # "de"

    # With REMOTE_ADDR and IP::Country installed:
    local $ENV{REMOTE_ADDR} = '8.8.8.8';
    print $l->country();   # "us" (depends on geo database)

=head3 MESSAGES

    "GEOIP_COUNTRY_CODE contains an invalid country code; ignoring"
    "HTTP_CF_IPCOUNTRY contains an invalid country code; ignoring"
    "X.X.X.X isn't a valid IP address"
    "Can't determine country from LAN connection X"
    "Can't determine country from loopback connection X"
    "cache contains a numeric country: N"
    "IP matches to a numeric country"

=head3 PSEUDOCODE

    1. Return cached _country if set
    2. Check GEOIP_COUNTRY_CODE env var (mod_geoip); validate /^[A-Z]{2}$/
    3. Check HTTP_CF_IPCOUNTRY (Cloudflare); skip 'XX'; validate /^[A-Z]{2}$/
    4. Untaint and validate REMOTE_ADDR; return undef if absent or invalid
    5. Skip private and loopback IPs (return undef)
    6. Check CHI cache; return cached value if present
    7. Try IP::Country::Fast (local DB, fastest)
    8. Try Geo::IP (local DB)
    9. Try Geo::IPfree (local DB, skip $BROKEN_GEOIPFREE)
    10. Try geoplugin.net JSON API (LWP::Simple::WithCache or LWP::Simple)
    11. Last resort: Net::Whois::IP then Net::Whois::IANA
    12. Sanitise: discard numeric, normalise HK->CN, handle EU special case
    13. Store in CHI cache; return result

=cut