File Coverage

lib/Web/ComposableRequest/Role/L10N.pm

Criterion	Covered	Total	%
statement	93	98	94.9
branch	21	30	70.0
condition	23	35	65.7
subroutine	22	22	100.0
pod	2	2	100.0
total	161	187	86.1

package Web::ComposableRequest::Role::L10N;

use namespace::autoclean;

use Web::ComposableRequest::Constants qw( NUL TRUE );
use Web::ComposableRequest::Util      qw( extract_lang is_member
                                          add_config_role );
use Unexpected::Functions             qw( inflate_placeholders );
use Unexpected::Types                 qw( ArrayRef CodeRef NonEmptySimpleStr
                                          Undef );
use Moo::Role;

requires qw( query_params _config _env );

add_config_role __PACKAGE__.'::Config';

# Attribute constructors
my $_build_locale = sub {
   my $self   = shift;
   my $conf   = $self->_config;
   my $locale = $self->query_params->('locale', { optional => TRUE });

   return $locale if $locale and is_member $locale, $conf->locales;

   my $lang;

   if ($locale and $lang = extract_lang($locale)) {
      return $lang if $lang ne $locale and is_member $lang, $conf->locales;
   }

   for my $locale (@{$self->locales}) {
      return $locale if is_member $locale, $conf->locales;
   }

   for my $lang (map { extract_lang $_ } @{$self->locales}) {
      return $lang if is_member $lang, $conf->locales;
   }

   return $conf->locale;
};

my $_build_locales = sub {
   my $self = shift;
   my $lang = $self->_env->{ 'HTTP_ACCEPT_LANGUAGE' } // NUL;

   return [ map    { s{ _ \z }{}mx; $_ }
            map    { join '_', $_->[ 0 ], uc( $_->[ 1 ] // NUL ) }
            map    { [ split m{ - }mx, $_ ] }
            map    { ( split m{ ; }mx, $_ )[ 0 ] }
            split m{ , }mx, lc $lang ];
};

my $_build_localiser = sub {
   return sub {
      my ($key, $args) = @_;

      defined $key or return; $key = "${key}"; chomp $key; $args //= {};

      my $text = $key;

      if (defined $args->{params} and ref $args->{params} eq 'ARRAY') {
         return $text if 0 > index $text, '[_';

         # Expand positional parameters of the form [_]
         return inflate_placeholders
            [ '[?]', '[]', $args->{no_quote_bind_values} ], $text,
            @{ $args->{params} };
      }

      return $text if 0 > index $text, '{';

      # Expand named parameters of the form {param_name}
      my %args = %{ $args };
      my $re   = join '|', map { quotemeta $_ } keys %args;

      $text =~ s{ \{($re)\} }{ defined $args{$1} ? $args{$1} : "{${1}?}" }egmx;

      return $text;
   };
};

# Public attributes
has 'domain'        => is => 'lazy', isa => NonEmptySimpleStr | Undef,
   builder          => sub {};

has 'domain_prefix' => is => 'lazy', isa => NonEmptySimpleStr | Undef;

has 'language'      => is => 'lazy', isa => NonEmptySimpleStr,
   builder          => sub { extract_lang $_[ 0 ]->locale };

has 'locale'        => is => 'lazy', isa => NonEmptySimpleStr,
   builder          => $_build_locale;

has 'locales'       => is => 'lazy', isa => ArrayRef[NonEmptySimpleStr],
   builder          => $_build_locales;

has 'localiser'     => is => 'lazy', isa => CodeRef,
   builder          => $_build_localiser;

my $_domains;

# Public methods
sub loc {
   my ($self, $key, @args) = @_;

   my $args = $self->_localise_args(@args);

   $args->{locale} //= $self->locale;

   return $self->localiser->($key, $args);
}

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

   my $args = $self->_localise_args(@args);

   $args->{locale} = $self->_config->locale;

   return $self->localiser->($key, $args);
}

# Private methods
sub _get_domains {
   my $self    = shift;
   my $domains = [ @{$self->_config->l10n_attributes->{domains} // []} ];
   my $domain  = $self->domain or return $domains;
   my $prefix  = $self->domain_prefix;

   $domain = "${prefix}-${domain}" if $prefix;
   push @{$domains}, $domain;

   return $domains;
}

sub _localise_args {
   my $self = shift;
   my $args =             ($_[0] && ref $_[0] eq 'HASH' ) ? { %{ $_[0] } }
            : { params => ($_[0] && ref $_[0] eq 'ARRAY') ? $_[0] : [@_] };

   $args->{domains} = $_domains //= $self->_get_domains
      unless exists $args->{domains};

   $args->{no_quote_bind_values} //= !$self->_config->quote_bind_values;

   return $args;
}

package Web::ComposableRequest::Role::L10N::Config;

use namespace::autoclean;

use Web::ComposableRequest::Constants qw( LANG TRUE );
use Unexpected::Types                 qw( ArrayRef Bool HashRef
                                          NonEmptySimpleStr );
use Moo::Role;

# Public attributes
has 'l10n_attributes'   => is => 'ro', isa => HashRef,
   builder              => sub { { domains => [ 'messages' ] } };

has 'locale'            => is => 'ro', isa => NonEmptySimpleStr,
   default              => LANG;

has 'locales'           => is => 'ro', isa => ArrayRef[NonEmptySimpleStr],
   builder              => sub { [ LANG ] };

has 'quote_bind_values' => is => 'ro', isa => Bool, default => TRUE;

1;

__END__