./TravEpi/SimpleRulesBase/Translator.pm

• package MGH_Biostat::TravEpi::SimpleRulesBase::Translator
  • new
  • valid_languages
  • is_valid_language
  • default_language
  • ordered_languages
  • get_inlanguage
  • translate_template
  • countries_menu
  • translate_dynamic_text
• EOF

package MGH_Biostat::TravEpi::SimpleRulesBase::Translator;
use Modern::Perl '2012';
use experimental 'switch';
use Carp;

use Set::Tiny qw(set);
use DOM::Tiny;

use Unicode::Collate::Locale;
use MGH_Biostat::Locale::POCatalog;
use MGH_Biostat::Locale::Locale;

use Package::Alias 'M_B::Countries' => 'MGH_Biostat::TravEpi::SimpleRulesBase::Countries';

sub new {
    my $class = shift;

    my $self = bless {
        'catalog'            => MGH_Biostat::Locale::POCatalog->new(),
        'locales'            => {},
        'country_sort_cache' => {},
    }, $class;

    foreach my $lang ( $self->{'catalog'}->langs->members() ) {
        $self->{'locales'}{$lang}            = MGH_Biostat::Locale::Locale->new($lang);
        $self->{'country_sort_cache'}{$lang} = {};
        my $collator = Unicode::Collate::Locale->new( locale => $lang );
        foreach my $country ( M_B::Countries->valid_countries->elements ) {
            $self->{'country_sort_cache'}{$lang}{$country} =
              $collator->getSortKey( $self->{'catalog'}->lookup( $lang, $country, 'Menu' )->msgstr );
        }
    }

    return $self;
}

# get a list of valid languages
sub valid_languages {
    my $self = shift;
    return $self->{'catalog'}->langs;
}

# test to see if a language is valid
sub is_valid_language {
    my $self = shift;
    my ($lang) = @_;

    return $self->valid_languages()->member($lang);
}

# get the default language
sub default_language {
    my $self = shift;
    return $self->{'catalog'}->default_lang;
}

# get an ordered list of the valid languages
sub ordered_languages {
    my $self = shift;
    return $self->{'catalog'}->langs_order;
}

# get back the "in <language>" form for a given language
sub get_inlanguage {
    my $self = shift;
    my ($lang) = @_;

    return $self->{'catalog'}->lookup( $lang, 'in language' )->msgstr;
}

# take the 'base' template and return a version specialized to a specific language
sub translate_template {
    my $self = shift;
    my ( $lang, $template ) = @_;

    my ( $langlong, $langshort ) = ( $lang =~ m/(([^-]+)(?:-.+)?)/ );

    my $replaces = {
        'langshort' => $langshort,
        'langlong'  => $langlong,
        'langdir'   => 'ltr',
        'countries' => $self->countries_menu($lang),
    };
    if ( $self->{'locales'}{$lang}->get_character_orientation_from_code() eq 'right-to-left' ) {
        $replaces->{'langdir'} = 'rtl';
    }

    foreach my $replace ( keys %$replaces ) {
        $template =~ s/!!\$$replace/$replaces->{$replace}/g;
    }

    my $dom = DOM::Tiny->new()->xml(0)->parse($template);
    $dom->find('*[data-gettext]')->each(
        sub {
            my $msgid = $_->content;
            for ($msgid) { s/\A\s+//; s/\s+\z//; }
            $_->content( $self->{'catalog'}->lookup( $lang, $msgid )->msgstr );
        }
    );

    $template = $dom->to_string();

    # hack to fix DOM::Tiny properly encoding items in HTML attributes
    # which breaks our template...
    $template =~ s/\&lt;\?ts/<?ts/g;
    $template =~ s/\?\&gt;/?>/g;

    return $template;
}

sub countries_menu {
    my $self = shift;
    my ($lang) = @_;

    my $ret = '';

    my $c = $self->{'country_sort_cache'}{$lang};
    foreach my $k ( sort { $c->{$a} cmp $c->{$b} } keys %$c ) {
        $ret .= '<option value="' . $k . '">' . $self->{'catalog'}->lookup( $lang, $k, 'Menu' )->msgstr . '</option>';
    }

    return $ret;
}

sub translate_dynamic_text {
    my $self = shift;
    my ( $dt, $lang ) = @_;

    my $locale = $self->{'locales'}{$lang};

    given ( $dt->{'type'} ) {
        when ('age') {
            return $self->{'catalog'}->lookup( $lang, '%s year old' )->msgstr_n_apply( $dt->{'value'} );
        }

        when ('countries') {
            my $context    = $dt->{'context'};
            my $po_context = $context->{'po-context'} // 'List';
            my $csc        = $self->{'country_sort_cache'}{$lang};

            my @countries =
              map { $self->{'catalog'}->lookup( $lang, $_, $po_context )->msgstr }
              sort { $csc->{$a} cmp $csc->{$b} }
              $dt->{'value'}->members();

            return $locale->get_list_and(@countries);
        }

        when ('destlinks') {
            my $context    = $dt->{'context'};
            my $po_context = $context->{'po-context'} // 'List';
            my $csc        = $self->{'country_sort_cache'}{$lang};
            return [
                map { { 'dest_link' => "cdc-redirect/$_", 'dest_link_name' => $self->{'catalog'}->lookup( $lang, $_, $po_context )->msgstr } }
                  sort { $csc->{$a} cmp $csc->{$b} }
                  $dt->{'value'}->members()
            ];
        }
    }

    carp "Unknown dynamic text type $dt->{'type'}";
    return 'not yet implemented';
}

1;