File Coverage

blib/lib/Locale/Maketext/Utils/Phrase/Norm.pm

Criterion	Covered	Total	%
statement	114	132	86.3
branch	51	64	79.6
condition	8	15	53.3
subroutine	34	41	82.9
pod	10	10	100.0
total	217	262	82.8

package Locale::Maketext::Utils::Phrase::Norm;

use strict;
use warnings;

$Locale::Maketext::Utils::Phrase::Norm::VERSION = '0.2';

use Module::Want ();
use Carp         ();

# IF YOU CHANGE THIS CHANGE THE “DEFAULT FILTERS” POD SECTION ALSO
my @default_filters = qw(NonBytesStr WhiteSpace Grapheme Ampersand Markup Ellipsis BeginUpper EndPunc Consider Escapes Compiles);    # IF YOU CHANGE THIS CHANGE THE “DEFAULT FILTERS” POD SECTION ALSO

# IF YOU CHANGE THIS CHANGE THE “DEFAULT FILTERS” POD SECTION ALSO

# TODO ?: Acronym, IntroComma, Parens (needs CLDR char/pattern in Locales.pm) [output,chr,(not|in|the|markup|list|or any if amp() etc happen )???

sub new_target {
    my $conf = ref( $_[-1] ) eq 'HASH' ? pop(@_) : {};

    # IF YOU CHANGE THIS CHANGE THE “new_target()” POD SECTION ALSO
    $conf->{'exclude_filters'}{'BeginUpper'} = 1;    # IF YOU CHANGE THIS CHANGE THE “new_target()” POD SECTION ALSO
    $conf->{'exclude_filters'}{'EndPunc'}    = 1;    # IF YOU CHANGE THIS CHANGE THE “new_target()” POD SECTION ALSO

    # IF YOU CHANGE THIS CHANGE THE “new_target()” POD SECTION ALSO

    push @_, $conf;
    goto &new_source;
}

sub new {
    Carp::carp('new() is deprecated, use new_source() instead');
    goto &new_source;
}

sub new_source {
    my $ns = shift;
    $ns = ref($ns) if ref($ns);    # just the class ma'am

    my $conf = ref( $_[-1] ) eq 'HASH' ? pop(@_) : {};

    my @filters;
    my %cr2ns;
    my $n;                         # buffer
    my @filternames;

    for $n ( $conf->{'skip_defaults_when_given_filters'} ? ( @_ ? @_ : @default_filters ) : ( @default_filters, @_ ) ) {
        my $name = $n =~ m/[:']/ ? $n : __PACKAGE__ . "::$n";

        next if ( exists $conf->{'exclude_filters'}{$n} && $conf->{'exclude_filters'}{$n} ) || ( exists $conf->{'exclude_filters'}{$name} && $conf->{'exclude_filters'}{$name} );

        if ( Module::Want::have_mod($name) ) {
            if ( my $cr = $name->can('normalize_maketext_string') ) {
                push @filters, $cr;
                $cr2ns{"$cr"} = $name;
                push @filternames, $name;
            }
            else {
                Carp::carp("$name does not implement normalize_maketext_string()");
                return;
            }
        }
        else {
            Carp::carp($@);
            return;
        }
    }

    if ( !@filters ) {
        Carp::carp("Filter list is empty!");
        return;
    }

    my $run_extra_filters = exists $conf->{'run_extra_filters'} ? ( $conf->{'run_extra_filters'} ? 1 : 0 ) : 0;

    my $new_obj = bless {
        'filters'           => \@filters,
        'cache'             => {},
        'filter_namespace'  => \%cr2ns,
        'filternames'       => \@filternames,
        'run_extra_filters' => $run_extra_filters,
        'maketext_object'   => undef,
    }, $ns;

    if ( exists $conf->{'maketext_object'} ) {
        $new_obj->set_maketext_object( $conf->{'maketext_object'} ) || return;
    }

    return $new_obj;
}

sub set_maketext_object {
    my ( $self, $mt_obj ) = @_;
    if ( ref($mt_obj) ) {
        if ( $mt_obj->can('makethis') ) {
            $self->delete_cache();
            $self->{'maketext_object'} = $mt_obj;
        }
        else {
            Carp::carp('Given maketext object does not have a makethis() method.');
            return;
        }
    }
    else {
        Carp::carp('Given maketext object is not a reference.');
        return;
    }

    return $self->{'maketext_object'};
}

sub get_maketext_object {
    return $_[0]->{'maketext_object'} if defined $_[0]->{'maketext_object'};

    # Do not delete cache since filters clas call this mid stream

    require Locale::Maketext::Utils::Mock;
    $_[0]->{'maketext_object'} = Locale::Maketext::Utils::Mock->get_handle();    # We can't do a class or else we get this sort of thing: Can't use string ("Locale::Maketext::Utils") as a HASH ref while "strict refs" in use at …/Locale/Maketext.pm line N.

    return $_[0]->{'maketext_object'};
}

sub enable_extra_filters {
    $_[0]->delete_cache();
    $_[0]->{'run_extra_filters'} = 1;
}

sub disable_extra_filters {
    $_[0]->delete_cache();
    $_[0]->{'run_extra_filters'} = 0;
}

sub run_extra_filters {
    return 1 if $_[0]->{'run_extra_filters'};
    return;
}

sub delete_cache {
    delete $_[0]->{'cache'};
}

sub normalize {
    my ( $self, $string ) = @_;

    if ( !defined $string ) {
        Carp::carp('You must pass a value to normalize()');
        return;
    }

    return $self->{'cache'}{$string} if exists $self->{'cache'}{$string};

    $self->{'cache'}{$string} = bless {
        'status'           => 1,
        'warning_count'    => 0,
        'violation_count'  => 0,
        'filter_results'   => [],
        'orig_str'         => $string,
        'aggregate_result' => $string,
      },
      'Locale::Maketext::Utils::Phrase::Norm::_Res';

    my $cr;    # buffer
    foreach $cr ( @{ $self->{'filters'} } ) {
        push @{ $self->{'cache'}{$string}{'filter_results'} }, bless {
            'status'     => 1,
            'package'    => $self->{'filter_namespace'}{"$cr"},
            'orig_str'   => $string,
            'new_str'    => $string,
            'violations' => [],                                   # status 0
            'warnings'   => [],                                   # status -1 (true but not 1)
            '_get_mt'    => sub {
                return $self->get_maketext_object();
            },
            '_run_extra' => sub {
                return $self->run_extra_filters();
            },
          },
          'Locale::Maketext::Utils::Phrase::Norm::_Res::Filter';

        my ( $filter_rc, $violation_count, $warning_count, $filter_modifies_string ) = $cr->( $self->{'cache'}{$string}{'filter_results'}[-1] );

        # Update string's overall aggregate modifcation
        if ($filter_modifies_string) {

            # Run aggregate value through filter, not perfect since it isn't operating on the same value as above
            my $agg_filt = bless {
                'status'     => 1,
                'package'    => $self->{'filter_namespace'}{"$cr"},
                'orig_str'   => $self->{'cache'}{$string}{'aggregate_result'},
                'new_str'    => $self->{'cache'}{$string}{'aggregate_result'},
                'violations' => [],                                              # status 0
                'warnings'   => [],                                              # status -1 (true but not 1)
                '_get_mt'    => sub {
                    return $self->get_maketext_object();
                },
                '_run_extra' => sub {
                    return $self->run_extra_filters();
                },
              },
              'Locale::Maketext::Utils::Phrase::Norm::_Res::Filter';

            $cr->($agg_filt);
            $self->{'cache'}{$string}{'aggregate_result'} = $agg_filt->get_new_str();
        }

        # Update string's overall result
        $self->{'cache'}{$string}{'violation_count'} += $violation_count;
        $self->{'cache'}{$string}{'warning_count'}   += $warning_count;
        if ( $self->{'cache'}{$string}->{'status'} ) {
            if ( !$filter_rc ) {
                $self->{'cache'}{$string}{'status'} = $filter_rc;
            }
            elsif ( $self->{'cache'}{$string}->{'status'} != -1 ) {
                $self->{'cache'}{$string}{'status'} = $filter_rc;
            }
        }

        last if !$filter_rc && $self->{'stop_filter_on_error'};    # TODO: document, add POD, methods, new_source(), tests etc.
    }

    return $self->{'cache'}{$string};
}

package Locale::Maketext::Utils::Phrase::Norm::_Res;

sub get_status {
    return $_[0]->{'status'};
}

sub get_warning_count {
    return $_[0]->{'warning_count'};
}

sub get_violation_count {
    return $_[0]->{'violation_count'};
}

sub get_filter_results {
    return $_[0]->{'filter_results'};
}

sub get_orig_str {
    return $_[0]->{'orig_str'};
}

sub get_aggregate_result {
    return $_[0]->{'aggregate_result'} || $_[0]->{'orig_str'};
}

sub filters_modify_string {
    return 1 if $_[0]->{'aggregate_result'} ne $_[0]->{'orig_str'};
    return;
}

package Locale::Maketext::Utils::Phrase::Norm::_Res::Filter;

sub run_extra_filters {
    return $_[0]->{'_run_extra'}->();
}

sub get_maketext_object {
    return $_[0]->{'_get_mt'}->();
}

sub add_violation {
    my ( $self, $error ) = @_;
    $self->{'status'} = 0;
    push @{ $self->{'violations'} }, $error;
}

sub add_warning {
    my ( $self, $warning ) = @_;
    $self->{'status'} = -1 if !$self->get_violations();
    push @{ $self->{'warnings'} }, $warning;
}

sub get_status {
    return $_[0]->{'status'};
}

sub get_package {
    return $_[0]->{'package'};
}

sub get_orig_str {
    return $_[0]->{'orig_str'};
}

sub get_new_str {
    return $_[0]->{'new_str'};
}

sub get_violations {
    return if !@{ $_[0]->{'violations'} };
    return $_[0]->{'violations'};
}

sub get_warnings {
    return if !@{ $_[0]->{'warnings'} };
    return $_[0]->{'warnings'};
}

sub get_string_sr {
    return \$_[0]->{'new_str'};
}

sub get_warning_count {
    return $_[0]->get_warnings() ? scalar( @{ $_[0]->get_warnings() } ) : 0;
}

sub get_violation_count {
    return $_[0]->get_violations() ? scalar( @{ $_[0]->get_violations() } ) : 0;
}

sub return_value {
    my ($self) = @_;
    return ( $self->{'status'}, $self->get_violation_count(), $self->get_warning_count(), $self->filter_modifies_string() );
}

sub return_value_noop {
    return ( 2, 0, 0, 0 );
}

sub filter_modifies_string {
    return 1 if $_[0]->{'orig_str'} ne $_[0]->{'new_str'};
    return;
}

1;

__END__