package Locale::TextDomain::OO::Lexicon::Role::StoreFilter; ## no critic (TidyCode)

use strict;
use warnings;
use Carp qw(confess);
use Clone qw(clone);
use Locale::TextDomain::OO::Singleton::Lexicon;
use Locale::TextDomain::OO::Util::JoinSplitLexiconKeys;
use Moo::Role;
use MooX::Types::MooseLike::Base qw(HashRef);
use namespace::autoclean;

our $VERSION = '1.017';

for my $name ( qw( language category domain project ) ) {
    has "filter_$name" => (
        is  => 'rw',
        isa => sub {
            my $value = shift;
            defined $value
                or return;
            my $ref = ref $value;
            $ref eq 'Regexp'
                and return;
            $ref eq 'CODE'
                and return;
            $ref
                and confess 'Undef, Str, RegexpRef or CodeRef expected';
        },
    );
}

sub clear_filter {
    my $self = shift;

    $self->filter_language(undef);
    $self->filter_category(undef);
    $self->filter_domain(undef);
    $self->filter_project(undef);

    return $self;
};

has data => (
    is      => 'ro',
    isa     => HashRef,
    lazy    => 1,
    default => sub { {} },
);

my $is_expected_lexicon_key = sub {
    my ( $self, $lexicon_key ) = @_;

    my $key_ref = Locale::TextDomain::OO::Util::JoinSplitLexiconKeys
        ->instance
        ->split_lexicon_key($lexicon_key);
    NAME:
    for my $name ( qw( language category domain project ) ) {
        defined $key_ref->{$name}
            or $key_ref->{$name} = q{};
        my $method = "filter_$name";
        my $filter = $self->$method;
        if ( defined $filter ) {
            local $_ = $key_ref->{$name};
            my $ref = ref $filter;
            $ref eq 'Regexp'
                ? $_ =~ $filter
                : $ref eq 'CODE'
                ? $filter->($method)
                : $_ eq $filter
                or return;
        }
    }

    return 1;
};

my $prepare_lexicon = sub {
    my ( $self, $lexicon_ref ) = @_;

    $lexicon_ref = clone($lexicon_ref);

    # not able to serialize code references
    delete $lexicon_ref->{ q{} }->{plural_code};

    my $key_util = Locale::TextDomain::OO::Util::JoinSplitLexiconKeys->instance;
    MESSAGE_KEY:
    for my $message_key ( keys %{$lexicon_ref} ) {
        length $message_key
            or next MESSAGE_KEY;
        my $new_message_key = $key_util->join_message_key(
            $key_util->split_message_key($message_key),
            'JSON',
        );
        $lexicon_ref->{$new_message_key} = delete $lexicon_ref->{$message_key};
    }

    return $lexicon_ref;
};

sub copy {
    my $self = shift;

    my $data = Locale::TextDomain::OO::Singleton::Lexicon->instance->data;
    for my $lexicon_key ( keys %{$data} ) {
        $self->$is_expected_lexicon_key($lexicon_key)
            and $self->data->{$lexicon_key}
                = $self->$prepare_lexicon( $data->{$lexicon_key} );
    }

    return $self;
}

sub remove {
    my $self = shift;

    my $data = $self->data;
    for my $lexicon_key ( keys %{$data} ) {
        $self->$is_expected_lexicon_key($lexicon_key)
            and delete $data->{$lexicon_key};
    }

    return $self;
}

1;

__END__

=head1 NAME

Locale::TextDomain::OO::Lexicon::Role::StoreFilter - Filters the lexicon data before stored

$Id: StoreFilter.pm 573 2015-02-07 20:59:51Z 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.017

=head1 DESCRIPTION

This module filters the lexicon data before stored.

The idea is: Not all parts of lexicon are used by other programming languages.

Implements attributes
"filter_language", "filter_category", "filter_domain" and "filter_project".
There it is possible to store
undef for ignore filter,
a string to check equal,
a regex reference to match
or a code reference to do some more complicate things.

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 $obj = Locale::TextDomain::OO::Lexicon::Store...->new(
        ...
        # all parameters optional
        filter_language => undef,
        filter_category => 'cat1',
        filter_domain   => qr{ \A dom }xms,
        filter_project  => sub {
            my $filter_name = shift;   # $filter_name eq 'filter_project'
            return $_ eq 'my project'; # $_ contains the value
        },
    );
    $obj->copy;
    $obj->clear_filter;
    $obj->filter_language('en');
    $obj->remove;
    $obj->to_...;

=head1 SUBROUTINES/METHODS

=head2 method filter_language, filter_category, filter_domain, filter_project

Set a filter as undef, string, regex or code reference.

=head2 method clear_filter

Set filter_language, filter_category, filter_domain, filter_project
to undef.

    $obj->clear_filter;

=head2 method copy

Copies lexicon entries with matching filter
from singleton lexicon to data (new lexicon).

    $obj->copy;

=head2 method remove

Removes lexicon entries with matching filter
from data (new lexicon).

    $obj->remove;

=head2 method data

Get back that filtered lexicon data.

    $data = $obj->data;

=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<Carp|Carp>

L<Clone|Clone>

L<Locale::TextDomain::OO::Singleton::Lexicon|Locale::TextDomain::OO::Singleton::Lexicon>

L<Locale::TextDomain::OO::Util::JoinSplitLexiconKeys|Locale::TextDomain::OO::Util::JoinSplitLexiconKeys>

L<Moo::Role|Moo::Role>

L<MooX::Types::MooseLike::Base|MooX::Types::MooseLike::Base>

L<namespace::autoclean|namespace::autoclean>

=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 - 2015,
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.