libcipux-cat-web-perl 3.4.0.3-4.2 / usr / share / perl5 / CipUX / CAT / Web / L10N.pm

# +========================================================================+
# || Copyright (C) 2009 - 2010 by Christian Kuelker                       ||
# ||                                                                      ||
# || License: GNU General Public License - GNU GPL - version 2            ||
# ||          or (at your opinion) any later version.                     ||
# +========================================================================+
# $Id$
# $Revision$
# $HeadURL$
# $Date$
# $Source$

package CipUX::CAT::Web::L10N;

use warnings;
use strict;
use Class::Std;
use Data::Dumper;
use English qw( -no_match_vars);
use Locale::Maketext::Lexicon;
use Log::Log4perl qw(get_logger :levels);
use Readonly;
use base qw(CipUX Locale::Maketext);

# CONST
Readonly::Scalar my $PATH_I18N => substr( __FILE__, 0, -7 ) . 'I18N';
Readonly::Scalar my $EMPTY_STRING => q{};

_do_import( { domain => $EMPTY_STRING } );

{
    use version; our $VERSION = qv('3.4.0.3');

    sub _do_import : PRIVATE {

        my ($arg_r) = @_;
        my $domain
            = ( exists $arg_r->{domain} ) ? $arg_r->{domain} : $EMPTY_STRING;

        my $import_hr = {
            _auto => 1,           # needed to set auto answer mode (really?)
            _AUTO => 1,           # needed to set auto answer mode (sure)
            en    => ['Auto'],    # set the answer source for en (!)
        };

        my $dest = join '/', ( $PATH_I18N, $domain, '*.po' );
        my @file = glob $dest;
        foreach my $f (@file) {
            my $tag = $f;         #'/usr/share/perl5/CipUX/CAT/Web/I18N/fr.po'
            $tag =~ s{^.*/}{}gmx;     # rm path/
            $tag =~ s{\.po$}{}gmx;    # rm .po

           # de => [ Gettext => '/usr/share/perl5/CipUX/CAT/Web/I18N/fr.po' ],
            if ( $tag =~ m{^[a-z-]+$} ) {
                $import_hr->{$tag} = [ Gettext => $f ];
            }
        }
        Locale::Maketext::Lexicon->import($import_hr);

        return;

    }

    sub import_lexicon {
        my ( $self, $arg_r ) = @_;

        my $domain
            = ( exists $arg_r->{domain} )
            ? $self->l( $arg_r->{domain} )
            : $self->perr('domain');

        _do_import( { domain => $domain } );

        return;

    }

    sub i18n_theme {
        my ( $self, $arg_r ) = @_;
        my $lh
            = ( exists $arg_r->{lh_obj} and defined $arg_r->{lh_obj} )
            ? $arg_r->{lh_obj}
            : $self->perr('lh_obj');
        my $cfg_hr
            = ( exists $arg_r->{cfg_hr} )
            ? $arg_r->{cfg_hr}
            : $self->perr('cfg_hr');

        my $l = get_logger(__PACKAGE__);
        my $theme_hr = { default => $lh->maketext('default') };    # fall back

        if ( exists $cfg_hr->{theme} and ref $cfg_hr->{theme} eq 'HASH' ) {

            # owerwrite theme_hr with translation where available
            foreach my $t ( %{ $cfg_hr->{theme} } ) {    # all themes
                next if $t eq $EMPTY_STRING;
                next if not exists $cfg_hr->{theme}->{$t};
                next if not defined $cfg_hr->{theme}->{$t};
                next if not $cfg_hr->{theme}->{$t};
                my $trans = $lh->maketext($t);
                next if not defined $trans;
                next if not $trans;

                # add only enabled theme with translation
                $theme_hr->{$t} = $trans;
            }
        }
        $l->debug( 'theme_hr: ', { filter => \&Dumper, value => $theme_hr } );
        return $theme_hr;
    }

    sub i18n_locale {
        my ( $self, $arg_r ) = @_;
        my $lh
            = ( exists $arg_r->{lh_obj} and defined $arg_r->{lh_obj} )
            ? $arg_r->{lh_obj}
            : $self->perr('lh_obj');
        my $cfg_hr
            = ( exists $arg_r->{cfg_hr} )
            ? $arg_r->{cfg_hr}
            : $self->perr('cfg_hr');
        my $l = get_logger(__PACKAGE__);

        my $locale_hr
            = ( exists $cfg_hr->{language} )
            ? $cfg_hr->{language}
            : { 'en' => 'English' };

        if ( exists $cfg_hr->{language}
            and ref $cfg_hr->{language} eq 'HASH' )
        {

            # owerwrite locale_hr with translation where available
            foreach my $tag ( %{ $cfg_hr->{language} } ) {
                next if $tag eq $EMPTY_STRING;
                next if not exists $cfg_hr->{language}->{$tag};
                next if not defined $cfg_hr->{language}->{$tag};
                next if not $cfg_hr->{language}->{$tag};
                my $trans = $lh->maketext( $cfg_hr->{language}->{$tag} );
                next if not defined $trans;
                next if not $trans;
                $locale_hr->{$tag} = $trans;
            }
        }
        $l->debug( 'locale_hr: ',
            { filter => \&Dumper, value => $locale_hr } );
        return $locale_hr;
    }

    # for debug, if you would like to know what the string to be translated is
    sub i18n {
        my ( $self, $lh, $s ) = @_;
        my $fn = '/tmp/cat.log';
        open my $f, q{>>}, $fn or die "Can not open $fn!\n";
        print $f "try to translate [$s]\n";
        close $f;
        my $trans = $lh->maketext($s);
        return $trans;

    }

    # not used, consider to use
    sub l10n_failure_handler {
        my ( $failing_lh, $key, $params ) = @_;

        #my $l = get_logger(__PACKAGE__);
        #$l->debug("translation failed for key [$key] in ");
        return;
    }

    # overwrite to trap errors
    sub maketext {
        my ( $lh, @stuff ) = @_;
        my $l = get_logger(__PACKAGE__);
        my $out;
        eval { $out = $lh->SUPER::maketext(@stuff) };
	if(not $EVAL_ERROR){
            foreach my $s (@stuff) {
            $l->debug("translate [$s] -> [$out]");
	    }

        return $out if not $EVAL_ERROR;
	}
        foreach my $s (@stuff) {
            $l->error("ERROR: Can not translate [$s]!");
        }
        return @stuff;
    }
}
1;