File Coverage

blib/lib/Captive/Portal/Role/I18N.pm

Criterion	Covered	Total	%
statement	51	56	91.0
branch	8	16	50.0
condition	3	5	60.0
subroutine	7	7	100.0
pod	2	2	100.0
total	71	86	82.5

package Captive::Portal::Role::I18N;

use strict;
use warnings;

=head1 NAME

Captive::Portal::Role::I18N - utils for internationalization

=cut

our $VERSION = '4.10';

use Log::Log4perl qw(:easy);
use Scalar::Util qw(looks_like_number);

use Role::Basic;
requires qw(cfg);

=head1 ROLES

=over 4

=item $capo->choose_language()

Parses the HTTP header 'Accept-Language' and returns an appropriate language from the configured languages or the fallback language in config file.

    I18N_LANGUAGES     => [ 'en', 'de', ],
    I18N_FALLBACK_LANG => 'en',

=cut

sub choose_language {
    my $self  = shift;
    my $query = $self->{CTX}{QUERY};

    my $http_accept_language = $query->http('HTTP_ACCEPT_LANGUAGE')
      || '';
    DEBUG("HTTP-Accept-Language is: $http_accept_language");

    ###
    # parse the HTTP header
    #
    # Example header: de-de,de;q=0.8,en-us;q=0.5,en;q=0.3
    #
    my $default_quant = 1;
    my %languages;

    foreach my $item ( split( /,/, $http_accept_language ) ) {
        $item =~ s/\s//g;    #strip spaces

        my ( $lang, $quant ) = split( /;q=/, $item );

        # don't use fine-granular language subtags for CaPo
        # cutoff the language subtags: de-AT => de
        $lang =~ s/-.*//;

        # skip silently the wildcard '*'
        next if $lang eq '*';

        # parse error, silently skip this language item
        next if defined $quant && ( not looks_like_number($quant) );

        # set the default language quantifier
        unless ( defined $quant ) {

            # give the first one a quant of 1
            $quant = $default_quant;

            # and the next without quantification .001 less
            $default_quant -= 0.001;
        }

        # first language entry
        unless ( $languages{$lang} ) {
            $languages{$lang} = $quant;
            next;
        }

        # override language entry with higher quant
        if ( $quant > $languages{$lang} ) {
            $languages{$lang} = $quant;
            next;
        }

    }

    # sort in descending quantification order
    my @accept_languages_sorted =
      sort { $languages{$b} <=> $languages{$a} } keys %languages;

    DEBUG( 'language prefered order is: '
          . join( ' > ', @accept_languages_sorted ) );

    DEBUG( 'configured languages: '
          . join( ' ', @{ $self->cfg->{I18N_LANGUAGES} } ) );

    # look for accepted language in configured languages
    my $choosen_language;
    foreach my $lang (@accept_languages_sorted) {
        if ( grep m/\A\Q$lang\E\Z/, @{ $self->cfg->{I18N_LANGUAGES} } ) {
	    DEBUG "prefered language is: $lang";
	    return $lang;
        }
    }

    DEBUG 'take fallback language';
    return $self->cfg->{I18N_FALLBACK_LANG};
}

=item $capo->gettext($msg_nr)

Poor mans gettext. Retrieve i18n system message from message catalog in config file. The default mesage catalog looks like:

    I18N_MSG_CATALOG => {
      msg_001 => {
        en => 'last session state was:',
        de => 'Status der letzten Sitzung war:',
      },

      msg_002 => {
        en => 'username or password is missing',
        de => 'Username oder Passwort fehlt',
      },

      msg_003 => {
        en => 'username or password is wrong',
        de => 'Username oder Passwort ist falsch',
      },

      msg_004 => {
        en => 'successfull logout',
        de => 'erfolgreich abgemeldet',
      },

      msg_005 => {
        en => 'admin_secret is wrong',
        de => 'Admin-Passwort ist falsch',
      },

      msg_006 => {
        en => 'Idle-session reestablished due to valid cookie.',
        de => 'Abgelaufene Sitzung durch gueltiges Cookie erneuert.',
      },
  },

Add your own translation to the conig hash.

=cut

sub gettext {
    my $self = shift;
    my $text = shift
      or LOGDIE 'missing param text';

    my $i18n_text =
      $self->cfg->{I18N_MSG_CATALOG}{$text}{ $self->{CTX}{LANG} };

    unless ($i18n_text) {
        ERROR "missing I18N text for '$text' in lang: $self->{CTX}{LANG}";
        $i18n_text = "missing '$text' for lang '$self->{CTX}{LANG}'";
    }

    return $i18n_text;
}

1;

=back

=head1 AUTHOR

Karl Gaissmaier, C<<  >>

=head1 LICENSE AND COPYRIGHT

Copyright 2010-2013 Karl Gaissmaier, all rights reserved.

This distribution is free software; you can redistribute it and/or modify it
under the terms of either:

a) the GNU General Public License as published by the Free Software
Foundation; either version 2, or (at your option) any later version, or

b) the Artistic License version 2.0.

=cut

# vim: sw=4