File Coverage

blib/lib/HTML/FormFu/Localize.pm

Criterion	Covered	Total	%
statement	78	84	92.8
branch	15	22	68.1
condition	5	12	41.6
subroutine	15	16	93.7
pod	0	7	0.0
total	113	141	80.1

use strict;

package HTML::FormFu::Localize;
# ABSTRACT: Localization
$HTML::FormFu::Localize::VERSION = '2.07';
use warnings;

use HTML::FormFu::Util qw( require_class );
use List::Util 1.33 qw( any );
use List::MoreUtils qw( pairwise );
use Scalar::Util qw( weaken isweak blessed );
use Exporter qw( import );
use Carp qw( croak );

our @EXPORT = qw(
    localize
    add_localize_object
    add_localize_object_from_class
    get_localize_object_from_class
    get_localize_object_dies_on_missing_key
    add_default_localize_object
    get_localize_object
);

sub localize {
    my ( $self, @original_strings ) = @_;

    @original_strings = grep {defined} @original_strings;

    if ( !$self->{has_default_localize_object} ) {
        $self->add_default_localize_object;
    }

    my @localized_strings;

    foreach my $localize_data ( @{ $self->{localize_data} } ) {
        my $localize_object = $self->get_localize_object($localize_data);

        eval {
            @localized_strings = $localize_object->localize(@original_strings);
        };

        next if $@;

        # NOTE:
        # As FormFu uses L10N to return messages based on artificial message
        # ids (instead of english language as message ids) the assumption
        # that we just got a result from Locale::Maketext with AUTO = 1 seems
        # to be safe when localize returns the same string as handed over.
        if (   !$localize_data->{dies_on_missing_key}
            && scalar(@original_strings) == scalar(@localized_strings)
            && scalar( any { !$_ } pairwise { $a eq $b } @original_strings,
                @localized_strings ) == 0
            )
        {
            next;
        }

        last if @localized_strings;
    }

    if ( !@localized_strings ) {
        @localized_strings = @original_strings;
    }

    return wantarray ? @localized_strings : $localized_strings[0];
}

sub add_localize_object {
    my ( $self, @objects ) = @_;

    croak 'no arguments given' if @_ < 2;

    foreach my $localize_object (@objects) {
        my $dies_on_missing_key = undef;

        if ( blessed $localize_object) {
            $dies_on_missing_key
                = $self->get_localize_object_dies_on_missing_key(
                $localize_object);
        }

        # add external localize object to the end of the list
        push @{ $self->{localize_data} },
            {
            localize_object     => $localize_object,
            dies_on_missing_key => $dies_on_missing_key,
            };

        if ( !exists $self->{weaken_localize_object}
            || $self->{weaken_localize_object} != 0
            && !isweak @{ $self->{localize_data} }[-1]->{localize_object} )
        {
            weaken @{ $self->{localize_data} }[-1]->{localize_object};
        }
        else {
            delete $self->{weaken_localize_object};
        }
    }

    return $self;
}

sub add_localize_object_from_class {
    my ( $self, @class ) = @_;

    $self->{weaken_localize_object} = 0;
    return $self->add_localize_object(
        map { $self->get_localize_object_from_class($_) } @class );
}

sub get_localize_object_from_class {
    my ( $self, $class ) = @_;

    require_class($class);

    my $languages = $self->languages;

    return $class->get_handle(@$languages);

}

sub get_localize_object_dies_on_missing_key {
    my ( $self, $localize_object ) = @_;

    # NOTE:
    # Findout how this class reacts on missing entries
    # this is an issue with catalyst and po-style localization
    #   (in pm-style localization, you could set
    #    $Hello::I18N::en::Lexicon{_AUTO} = 0;
    #    to avoid autocreating missing keys)

    # HINT:
    # Never use underscores for the beginning of the testkey as they
    # will lead Locale::Maketext to croak even if _AUTO is on (1) as
    # Locale::Maketext useses underscores to identify text for
    # processing via the AUTO-function (_compile).

    my $testkey = 'html_formfu_missing_key_test';

    eval { $localize_object->localize($testkey) };

    my $dies_on_missing_key = $@ ? 1 : 0;

    return $dies_on_missing_key;
}

sub add_default_localize_object {
    my ($self) = @_;

    my $localize_object
        = $self->get_localize_object_from_class( $self->localize_class );

    my $dies_on_missing_key = 1;

    # put FormFu localize object in first place
    unshift @{ $self->{localize_data} },
        {
        localize_object     => $localize_object,
        dies_on_missing_key => $dies_on_missing_key,
        };

    $self->{has_default_localize_object} = 1;

    return $self;
}

sub get_localize_object {
    my ( $self, $localize_data ) = @_;

    if ( !blessed $localize_data->{localize_object} ) {

        $localize_data->{localize_object}
            = $self->get_localize_object_from_class( $self->localize_class );

        $localize_data->{dies_on_missing_key}
            = $self->get_localize_object_dies_on_missing_key(
            $localize_data->{localize_object} );
    }

    return $localize_data->{localize_object};
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

HTML::FormFu::Localize - Localization

=head1 VERSION

version 2.07

=head1 AUTHOR

Carl Franks <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2018 by Carl Franks.

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

=cut