package Locale::TextDomain::OO::Lexicon::Role::StoreFilter; ## no critic (TidyCode)
use strict;
use warnings;
use List::MoreUtils qw(any);
use Locale::TextDomain::OO::Singleton::Lexicon;
use Moo::Role;
use MooX::Types::MooseLike::Base qw(ArrayRef);
use namespace::autoclean;
our $VERSION = '1.011';
with qw(
Locale::TextDomain::OO::Lexicon::Role::Constants
);
has filter_language => (
is => 'ro',
isa => ArrayRef,
lazy => 1,
default => sub { [] },
);
has filter_category => (
is => 'ro',
isa => ArrayRef,
lazy => 1,
default => sub { [] },
);
has filter_domain => (
is => 'ro',
isa => ArrayRef,
lazy => 1,
default => sub { [] },
);
has filter_language_category => (
is => 'ro',
isa => ArrayRef,
lazy => 1,
default => sub { [] },
);
has filter_language_domain => (
is => 'ro',
isa => ArrayRef,
lazy => 1,
default => sub { [] },
);
has filter_category_domain => (
is => 'ro',
isa => ArrayRef,
lazy => 1,
default => sub { [] },
);
has filter_language_category_domain => (
is => 'ro',
isa => ArrayRef,
lazy => 1,
default => sub { [] },
);
has _language_category_domain_regex => (
is => 'ro',
lazy => 1,
default => sub {
my $self = shift;
my $separator = $self->lexicon_key_separator;
my $not_separator_regex = sprintf '[^%s]', quotemeta $separator;
return [
(
map {
qr{
\A
\Q$_\E
\Q$separator\E
$not_separator_regex*
\Q$separator\E
$not_separator_regex*
\z
}xms;
} @{ $self->filter_language }
),
(
map {
qr{
\A
$not_separator_regex*
\Q$separator\E
\Q$_\E
\Q$separator\E
$not_separator_regex*
\z
}xms;
} @{ $self->filter_category }
),
(
map {
qr{
\A
$not_separator_regex*
\Q$separator\E
$not_separator_regex*
\Q$separator\E
\Q$_\E
\z
}xms;
} @{ $self->filter_domain }
),
(
map { ## no critic (ComplexMappings)
my $language = $_->{language} || q{};
my $category = $_->{category} || q{};
qr{
\A
\Q$language\E
\Q$separator\E
\Q$category\E
\Q$separator\E
$not_separator_regex*
\z
}xms;
} @{ $self->filter_language_category }
),
(
map { ## no critic (ComplexMappings)
my $language = $_->{language} || q{};
my $domain = $_->{domain} || q{};
qr{
\A
\Q$language\E
\Q$separator\E
$not_separator_regex*
\Q$separator\E
\Q$domain\E
\z
}xms;
} @{ $self->filter_language_domain }
),
(
map { ## no critic (ComplexMappings)
my $category = $_->{category} || q{};
my $domain = $_->{domain} || q{};
qr{
\A
$not_separator_regex*
\Q$separator\E
\Q$category\E
\Q$separator\E
\Q$domain\E
\z
}xms;
} @{ $self->filter_category_domain }
),
(
map { ## no critic (ComplexMappings)
my $language = $_->{language} || q{};
my $category = $_->{category} || q{};
my $domain = $_->{domain} || q{};
qr{
\A
\Q$language\E
\Q$separator\E
\Q$category\E
\Q$separator\E
\Q$domain\E
\z
}xms;
} @{ $self->filter_language_category_domain }
),
],
},
);
sub data {
my ( $self, $arg_ref ) = @_;
my $data = Locale::TextDomain::OO::Singleton::Lexicon->instance->data;
my $regex = $self->_language_category_domain_regex;
$data = {
map { ## no critic (ComplexMappings)
my $lexicon = { %{ $data->{$_} } };
# not able to serialize code references
delete $lexicon->{ q{} }->{plural_code};
SEPARATOR_NAME:
for my $separator_name ( qw( msg_key_separator plural_separator ) ) {
my $text_separator_name = $arg_ref->{$separator_name}
or next SEPARATOR_NAME;
my $binary_separator = $self->$separator_name;
for my $lexicon_key ( keys %{$lexicon} ) {
my $new_key = $lexicon_key;
$new_key =~ s{
\Q$binary_separator\E
}{$text_separator_name}xmsg;
$lexicon->{$new_key}
= delete $lexicon->{$lexicon_key};
}
}
$_ => $lexicon;
}
grep {
my $lexicon_name = $_;
@{$regex}
? any { $lexicon_name =~ $_ } @{$regex}
: 1;
}
keys %{$data}
};
return $data;
}
1;
__END__
=head1 NAME
Locale::TextDomain::OO::Lexicon::Role::StoreFilter - Filters the lexicon data before stored
$Id: StoreFilter.pm 499 2014-05-12 12:53:39Z steffenw $
$HeadURL: svn+ssh://steffenw@svn.code.sf.net/p/perl-gettext-oo/code/module/trunk/lib/Locale/TextDomain/OO/Lexicon/Role/StoreFilter.pm $
=head1 VERSION
1.011
=head1 DESCRIPTION
This module filters the lexicon date before stored.
The idea is: Not all parts of lexicon are used by other languages.
Implements attributes "filter_language", "filter_category", "filter_domain"
and combinations of that up to "filter_language_category_domain".
That filter removes also the key "plural_code" from header.
That is an already prepared Perl code reference
to calculate what plural form should used.
The other language has to create the code again from key header key "plural".
That contains that pseudo code from po/mo file
without C<;> and/or C<\n> at the end.
=head1 SYNOPSIS
with qw(
Locale::TextDomain::OO::Lexicon::Role::StoreFilter
);
Usage of that optional filter
use Locale::TextDomain::OO::Lexicon::Store...;
my $json = Locale::TextDomain::OO::Lexicon::Store...
->new(
...
# all parameters optional
filter_language => [
# this languages and unchecked domain and category
qw( language1 language2 ),
],
filter_category => [
# this categories and unchecked language and domain
qw( category1 category2 ),
],
filter_domain => [
# this domains and unchecked language and category
qw( domain1 domain2 ),
],
filter_language_category => [
{
# empty language
# empty category
# unchecked domain
},
{
language => 'language1',
# empty category
# unchecked domain
},
{
# empty language,
category => 'category1',
# unchecked domain
},
{
language => 'language1',
category => 'category1',
# unchecked domain
},
},
filter_language_domain => [
{
# empty language
# unchecked category
# empty domain
},
...
{
language => 'language1',
# unchecked category
domain => 'domain1',
},
},
filter_domain_category => [
{
# unchecked language
# empty category
# empty domain
},
...
{
# unchecked language
category => 'category1',
domain => 'domain1',
},
},
filter_language_domain_category => [
{
# empty language
# empty category
# empty domain
},
...
{
language => 'language1',
category => 'category1',
domain => 'domain1',
},
},
)
->to_...;
=head1 SUBROUTINES/METHODS
=head2 method data
Get back that filtered lexicon data.
$data = $self->data;
or for special cases without control chars
$data = $self->data({
msg_key_separator => '{MSG_KEY_SEPARATOR}',
plural_separator => '{PLURAL_SEPARATOR}',
});
=head1 EXAMPLE
Inside of this distribution is a directory named example.
Run this *.pl files.
=head1 DIAGNOSTICS
none
=head1 CONFIGURATION AND ENVIRONMENT
none
=head1 DEPENDENCIES
L<List::MoreUtils|List::MoreUtils>
L<Locale::TextDomain::OO::Singleton::Lexicon|Locale::TextDomain::OO::Singleton::Lexicon>
L<Moo::Role|Moo::Role>
L<MooX::Types::MooseLike::Base|MooX::Types::MooseLike::Base>
L<namespace::autoclean|namespace::autoclean>
L<Locale::TextDomain::OO::Lexicon::Role::Constants|Locale::TextDomain::OO::Lexicon::Role::Constants>
=head1 INCOMPATIBILITIES
not known
=head1 BUGS AND LIMITATIONS
none
=head1 SEE ALSO
L<Locale::TextDoamin::OO|Locale::TextDoamin::OO>
=head1 AUTHOR
Steffen Winkler
=head1 LICENSE AND COPYRIGHT
Copyright (c) 2013 - 2014,
Steffen Winkler
C<< <steffenw at cpan.org> >>.
All rights reserved.
This module is free software;
you can redistribute it and/or modify it
under the same terms as Perl itself.