File Coverage

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

Criterion	Covered	Total	%
statement	49	49	100.0
branch	22	22	100.0
condition	36	45	80.0
subroutine	4	4	100.0
pod	0	1	0.0
total	111	121	91.7

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

use strict;
use warnings;
use Locale::Maketext::Utils::Phrase ();

sub normalize_maketext_string {
    my ($filter) = @_;

    my $string_sr = $filter->get_string_sr();

    my $struct = Locale::Maketext::Utils::Phrase::phrase2struct( ${$string_sr} );

    # entires phrase is bracket notation
    if ( Locale::Maketext::Utils::Phrase::struct_is_entirely_bracket_notation($struct) ) {
        ${$string_sr} .= "[comment,does this phrase really need to be entirely bracket notation?]";
        $filter->add_warning('Entire phrase is bracket notation, is there a better way in this case?');
    }

    my $idx          = -1;
    my $has_bare     = 0;
    my $has_hardurl  = 0;
    my $last_idx     = @{$struct} - 1;
    my $bn_var_rexep = Locale::Maketext::Utils::Phrase::get_bn_var_regexp();

    for my $piece ( @{$struct} ) {
        $idx++;
        next if !ref($piece);

        my $before = $idx == 0 ? '' : $struct->[ $idx - 1 ];
        my $bn     = $piece->{'orig'};
        my $after  = $idx == $last_idx ? '' : $struct->[ $idx + 1 ];

        if ( $piece->{'type'} eq 'var' || $piece->{'type'} eq 'basic_var' ) {

            # unless the “bare” bracket notation  …
            unless (
                ( $idx == $last_idx && $before =~ m/\:(?:\x20|\xc2\xa0)/ && ( !defined $after || $after eq '' ) )    # … is a trailing '…: [_2]'
                #tidyoff
                or (
                    ( $before !~ m/(?:\x20|\xc2\xa0)$/ && $after !~ m/^(?:\x20|\xc2\xa0)/ ) # … is surrounded by non-whitespace already
                    &&
                    ( $before !~ m/[a-zA-Z0-9]$/ && $after !~ m/^[a-zA-Z0-9]/ )             # … and that non-whitespace is also non-alphanumeric (TODO target phrases need a lookup)
                )
                #tidyon
                or ( $before =~ m/,(?:\x20|\xc2\xa0)$/        && $after =~ m/^,/ )                                        # … is in a comma reference
                or ( $before =~ m/\([^\)]+(?:\x20|\xc2\xa0)$/ && $after =~ m/^\)/ )                                       # … is at the end of parenthesised text
                or ( $before =~ m/\($/                        && $after =~ m/(?:\x20|\xc2\xa0)[^\)]+\)/ )                 # … is at the beginning of parenthesised text
                or ( $before =~ m/(?:\x20|\xc2\xa0)$/         && $after =~ m/’s(?:\x20|\xc2\xa0|;.|,.|[\!\?\.\:])/ )    # … is an apostrophe-s (curly so its not markup!)

              ) {
                ${$string_sr} =~ s/(\Q$bn\E)/“$1”/;
                $has_bare++;
            }
        }

        # Do not hardcode URL in [output,url]:
        if ( $piece->{'list'}[0] eq 'output' && $piece->{'list'}[1] eq 'url' ) {
            if ( $piece->{'list'}[2] !~ m/\A$bn_var_rexep\z/ ) {
                my $last_idx_bn = @{ $piece->{'list'} } - 1;
                my $url         = $piece->{'list'}[2];
                my $args        = @{ $piece->{'list'} } > 3 ? ',' . join( ',', @{ $piece->{'list'} }[ 3 .. $last_idx_bn ] ) : '';

                ${$string_sr} =~ s/(\Q$bn\E)/\[output,url,why hardcode “$url”$args\]/;
                $has_hardurl++;
            }
        }
    }

    $filter->add_warning('Hard coded URLs can be a maintenance nightmare, why not pass the URL in so the phrase does not change if the URL does') if $has_hardurl;
    $filter->add_warning('Bare variable can lead to ambiguous output')                                                                            if $has_bare;

    return $filter->return_value;
}

1;

__END__