view release on metacpan or  search on metacpan

lib/Web/ComposableRequest/Role/L10N.pm  view on Meta::CPAN

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 [_<n>]
         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);