view release on metacpan or  search on metacpan

lib/Class/Usul/L10N.pm  view on Meta::CPAN

package Class::Usul::L10N;

use namespace::autoclean;

use Class::Null;
use Class::Usul::Constants   qw( FALSE LANG NUL SEP TRUE );
use Class::Usul::Functions   qw( assert is_arrayref
                                 is_hashref merge_attributes );
use Class::Usul::Types       qw( ArrayRef Bool HashRef Logger SimpleStr Str );
use File::DataClass::Types   qw( Directory Path );
use File::Gettext;
use File::Gettext::Constants qw( CONTEXT_SEP LOCALE_DIRS );
use File::Spec::Functions    qw( tmpdir );
use Try::Tiny;
use Unexpected::Functions    qw( inflate_placeholders );
use Moo;

# Public attributes
has 'l10n_attributes' => is => 'lazy', isa => HashRef, builder => sub { {} };

has 'locale'          => is => 'lazy', isa => SimpleStr, default => LANG;

has 'localedir'       => is => 'lazy', isa => Path, coerce => TRUE,
   builder            => sub { LOCALE_DIRS->[ 0 ] };

has 'log'             => is => 'ro',   isa => Logger,
   builder            => sub { Class::Null->new };

has 'tempdir'         => is => 'lazy', isa => Directory, coerce => TRUE,
   builder            => sub { tmpdir };

# Private attributes
has '_domains'        => is => 'lazy', isa => ArrayRef[Str], builder => sub {
   $_[ 0 ]->l10n_attributes->{domains} // [ 'messages' ] },
   reader             => 'domains';

has '_source_name'    => is => 'lazy', isa => SimpleStr, builder => sub {
   $_[ 0 ]->l10n_attributes->{source_name} // 'po' },
   reader             => 'source_name';

has '_use_country'    => is => 'lazy', isa => Bool, builder => sub {
   $_[ 0 ]->l10n_attributes->{use_country} // FALSE },
   reader             => 'use_country';

# Class attributes
my $domain_cache = {}; my $locale_cache = {};

# Private methods
my $_extract_lang_from = sub {
   my ($self, $locale) = @_;

   exists $locale_cache->{ $locale } and return $locale_cache->{ $locale };

   my $sep  = $self->use_country ? '.' : '_';
   my $lang = (split m{ \Q$sep\E }msx, $locale.$sep )[ 0 ];

   return $locale_cache->{ $locale } = $lang;
};

my $_load_domains = sub {
   my ($self, $args) = @_; my $charset;

   assert $self, sub { $args->{locale} }, 'No locale id';

   my $locale = $args->{locale} or return;
   my $lang   = $self->$_extract_lang_from( $locale );
   my $names  = $args->{domains} // $args->{domain_names} // $self->domains;
   my @names  = grep { defined and length } @{ $names };
   my $key    = $lang.SEP.(join '+', @names );

   defined $domain_cache->{ $key } and return $domain_cache->{ $key };

   my $attrs  = { %{ $self->l10n_attributes }, builder => $self,
                  source_name => $self->source_name, };

   defined $self->localedir and $attrs->{localedir} = $self->localedir;

   $locale    =~ m{ \A (?: [a-z][a-z] )
                       (?: (?:_[A-Z][A-Z] )? \. ( [-_A-Za-z0-9]+ )? )?
                       (?: \@[-_A-Za-z0-9=;]+ )? \z }msx and $charset = $1;
   $charset and $attrs->{charset} = $charset;

   my $domain = try   { File::Gettext->new( $attrs )->load( $lang, @names ) }
                catch { $self->log->error( $_ ); return };

   return $domain ? $domain_cache->{ $key } = $domain : undef;
};

my $_gettext = sub {
   my ($self, $key, $args) = @_;

   my $count   = $args->{count} || 1;
   my $default = $args->{no_default} ? NUL : $key;
   my $domain  = $self->$_load_domains( $args )
      or return ($default, $args->{plural_key})[ $count > 1 ] // $default;
   # Select either singular or plural translation
   my ($nplurals, $plural) = (1, 0);

   if ($count > 1) { # Some languages have more than one plural form
      ($nplurals, $plural) = $domain->{plural_func}->( $count );
      defined   $nplurals  or $nplurals = 0;
      defined    $plural   or  $plural  = 0;
      $plural > $nplurals and  $plural  = $nplurals;
   }

   my $id   = defined $args->{context}
            ? $args->{context}.CONTEXT_SEP.$key : $key;
   my $msgs = $domain->{ $self->source_name } // {};
   my $msg  = $msgs->{ $id } // {};

   return @{ $msg->{msgstr} // [] }[ $plural ] // $default;
};

# Construction
around 'BUILDARGS' => sub {