The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Locale::TextDomain::OO::Translator; ## no critic (TidyCode)

use strict;
use warnings;
use Carp qw(confess);
use Locale::TextDomain::OO::Singleton::Lexicon;
use Moo;
use MooX::StrictConstructor;
use MooX::Types::MooseLike::Base qw(Str);
use namespace::autoclean;

our $VERSION = '1.008';

with qw(
    Locale::TextDomain::OO::Lexicon::Role::Constants
    Locale::TextDomain::OO::Role::Logger
);

sub load_plugins {
    my ( $class, @args ) = @_;

    my %arg_of = @args == 1 ? %{ $args[0] } : @args;
    my $plugins = delete $arg_of{plugins};
    if ( $plugins ) {
        ref $plugins eq 'ARRAY'
            or confess 'Attribute plugins expected as ArrayRef';
        for my $plugin ( @{$plugins} ) {
            my $package = ( 0 == index $plugin, q{+} )
                ? $plugin
                : "Locale::TextDomain::OO::Plugin::$plugin";
            with $package;
        }
    }

    return \%arg_of;
}

has language => (
    is      => 'rw',
    isa     => Str,
    default => 'i-default',
);

has category => (
    is      => 'rw',
    isa     => Str,
    default => q{},
);

has domain => (
    is      => 'rw',
    isa     => Str,
    default => q{},
);

has filter => (
    is  => 'rw',
    isa => sub {
        my $arg = shift;
        # Undef
        defined $arg
            or return;
        # CodeRef
        ref $arg eq 'CODE'
            and return;
        confess "$arg is not Undef or CodeRef";
    },
);

sub _calculate_multiplural_index {
    my ($self, $count_ref, $plural_code, $lexicon, $lexicon_key) = @_;

    my $nplurals = $lexicon->{ q{} }->{multiplural_nplurals}
        or confess qq{X-Multiplural-Nplurals not found in lexicon "$lexicon_key"};
    my @counts = @{$count_ref}
        or confess 'Count array is empty';
    my $index = 0;
    while (@counts) {
        $index *= $nplurals;
        my $count = shift @counts;
        $index += $plural_code->($count);
    }

    return $index;
}

sub translate { ## no critic (ExcessComplexity ManyArgs)
    my ($self, $msgctxt, $msgid, $msgid_plural, $count, $is_n) = @_;

    my $lexicon_key = join $self->lexicon_key_separator, (
        $self->language,
        $self->category,
        $self->domain,
    );
    my $lexicon = Locale::TextDomain::OO::Singleton::Lexicon->instance->data;
    $lexicon = exists $lexicon->{$lexicon_key}
        ? $lexicon->{$lexicon_key}
        : ();

    my $length_or_empty_list = sub {
        my $item = shift;
        defined $item or return;
        length $item or return;
        return $item;
    };
    my $msg_key = join $self->msg_key_separator,
        $length_or_empty_list->($msgctxt),
        join $self->plural_separator,
            $length_or_empty_list->($msgid),
            $length_or_empty_list->($msgid_plural);
    if ( $is_n ) {
        my $plural_code = $lexicon->{ q{} }->{plural_code}
            or confess qq{Plural-Forms not found in lexicon "$lexicon_key"};
        my $multiplural_index = ref $count eq 'ARRAY'
            ? $self->_calculate_multiplural_index($count, $plural_code, $lexicon, $lexicon_key)
            : $plural_code->($count);
        my $msgstr_plural = exists $lexicon->{$msg_key}
            ? $lexicon->{$msg_key}->{msgstr_plural}->[$multiplural_index]
            : ();
        if ( ! defined $msgstr_plural ) { # fallback
            $msgstr_plural = $plural_code->($count)
                ? $msgid_plural
                : $msgid;
            my $text = $lexicon
                ? qq{Using lexicon "$lexicon_key".}
                : qq{Lexicon "$lexicon_key" not found.};
            $self->language ne 'i-default'
                and $self->logger
                and $self->logger->(
                    (
                        sprintf
                            '%s msgstr_plural not found for for msgctxt=%s, msgid=%s, msgid_plural=%s.',
                            $text,
                            ( defined $msgctxt      ? qq{"$msgctxt"}      : 'undef' ),
                            ( defined $msgid        ? qq{"$msgid"}        : 'undef' ),
                            ( defined $msgid_plural ? qq{"$msgid_plural"} : 'undef' ),
                    ),
                    {
                        object => $self,
                        type   => 'warn',
                        event  => 'translation,fallback',
                    },
                );
        }
        return $msgstr_plural;
    }
    my $msgstr = exists $lexicon->{$msg_key}
        ? $lexicon->{$msg_key}->{msgstr}
        : ();
    if ( ! defined $msgstr ) { # fallback
        $msgstr = $msgid;
        my $text = $lexicon
            ? qq{Using lexicon "$lexicon_key".}
            : qq{Lexicon "$lexicon_key" not found.};
        $self->language ne 'i-default'
            and $self->logger
            and $self->logger->(
                (
                    sprintf
                        '%s msgstr not found for msgctxt=%s, msgid=%s.',
                        $text,
                        ( defined $msgctxt ? qq{"$msgctxt"} : 'undef' ),
                        ( defined $msgid   ? qq{"$msgid"}   : 'undef' ),
                ),
                {
                    object => $self,
                    type  => 'warn',
                    event => 'translation,fallback',
                },
            );
    }

    return $msgstr;
}

sub run_filter {
    my ( $self, $translation_ref ) = @_;

    $self->filter
        or return $self;
    $self->filter->($self, $translation_ref);

    return $self;
}

__PACKAGE__->meta->make_immutable;

1;

__END__

=head1 NAME

Locale::TextDomain::OO::Translator - Translator class

$Id: Translator.pm 472 2014-01-21 16:37:44Z steffenw $

$HeadURL: svn+ssh://steffenw@svn.code.sf.net/p/perl-gettext-oo/code/module/trunk/lib/Locale/TextDomain/OO/Translator.pm $

=head1 VERSION

1.008

=head1 DESCRIPTION

This is the translator class. Extend that class with plugins (Roles).

=head1 SYNOPSIS

    require Locale::TextDomain::OO::Translator;
    Locale::TextDomain::OO::Translator->new(
        Locale::TextDomain::OO::Translator->load_plugins,
    );

=head1 SUBROUTINES/METHODS

=head2 class method load_plugins

Called before new to load the plugins.

    $hash_ref = Locale::TextDomain::OO::Translator->load_plugins;

=head2 method translate

Called from Plugins only.

    $translation = $self->translate(... lots of parameters ...);

=head2 method run_filter

Called from plugins only.

    $self->run_filter(\$translation);

=head1 EXAMPLE

Inside of this distribution is a directory named example.
Read the file README there.
Then run the *.pl files.

=head1 DIAGNOSTICS

confess

=head1 CONFIGURATION AND ENVIRONMENT

none

=head1 DEPENDENCIES

L<Moo|Moo>

L<MooX::StrictConstructor|MooX::StrictConstructor>

L<MooX::Types::MooseLike::Base|MooX::Types::MooseLike::Base>

L<Carp|Carp>

L<Locale::TextDomain::OO::Singleton::Lexicon|Locale::TextDomain::OO::Singleton::Lexicon>

L<namespace::autoclean|namespace::autoclean>

=head1 INCOMPATIBILITIES

not known

=head1 BUGS AND LIMITATIONS

not known

=head1 AUTHOR

Steffen Winkler

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2013 - 2014,
Steffen Winkler
C<< <steffenw at cpan.org> >>.
All rights reserved.

This module is free software;
you can redistribute it and/or modify it
under the same terms as Perl itself.