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


line stmt bran cond sub pod time code
1             package Locale::Maketext::Utils::Phrase::Norm::Consider;
2              
3 4     4   6052 use strict;
  4         100  
  4         153  
4 4     4   21 use warnings;
  4         8  
  4         102  
5 4     4   4564 use Locale::Maketext::Utils::Phrase ();
  4         10  
  4         4093  
6              
7             sub normalize_maketext_string {
8 98     98 0 169 my ($filter) = @_;
9              
10 98         393 my $string_sr = $filter->get_string_sr();
11              
12 98         163 my $struct = Locale::Maketext::Utils::Phrase::phrase2struct( ${$string_sr} );
  98         414  
13              
14             # entires phrase is bracket notation
15 98 100       407 if ( Locale::Maketext::Utils::Phrase::struct_is_entirely_bracket_notation($struct) ) {
16 8         13 ${$string_sr} .= "[comment,does this phrase really need to be entirely bracket notation?]";
  8         25  
17 8         35 $filter->add_warning('Entire phrase is bracket notation, is there a better way in this case?');
18             }
19              
20 98         169 my $idx = -1;
21 98         110 my $has_bare = 0;
22 98         124 my $has_hardurl = 0;
23 98         138 my $last_idx = @{$struct} - 1;
  98         168  
24 98         316 my $bn_var_rexep = Locale::Maketext::Utils::Phrase::get_bn_var_regexp();
25              
26 98         188 for my $piece ( @{$struct} ) {
  98         222  
27 358         426 $idx++;
28 358 100       1136 next if !ref($piece);
29              
30 150 100       466 my $before = $idx == 0 ? '' : $struct->[ $idx - 1 ];
31 150         251 my $bn = $piece->{'orig'};
32 150 100       346 my $after = $idx == $last_idx ? '' : $struct->[ $idx + 1 ];
33              
34 150 100 66     755 if ( $piece->{'type'} eq 'var' || $piece->{'type'} eq 'basic_var' ) {
35              
36             # unless the “bare” bracket notation …
37 98 100 100     4836 unless (
      33        
      66        
      100        
      100        
      100        
      66        
      66        
      66        
      100        
      66        
      100        
      66        
38             ( $idx == $last_idx && $before =~ m/\:(?:\x20|\xc2\xa0)/ && ( !defined $after || $after eq '' ) ) # … is a trailing '…: [_2]'
39             #tidyoff
40             or (
41             ( $before !~ m/(?:\x20|\xc2\xa0)$/ && $after !~ m/^(?:\x20|\xc2\xa0)/ ) # … is surrounded by non-whitespace already
42             &&
43             ( $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)
44             )
45             #tidyon
46             or ( $before =~ m/,(?:\x20|\xc2\xa0)$/ && $after =~ m/^,/ ) # … is in a comma reference
47             or ( $before =~ m/\([^\)]+(?:\x20|\xc2\xa0)$/ && $after =~ m/^\)/ ) # … is at the end of parenthesised text
48             or ( $before =~ m/\($/ && $after =~ m/(?:\x20|\xc2\xa0)[^\)]+\)/ ) # … is at the beginning of parenthesised text
49             or ( $before =~ m/(?:\x20|\xc2\xa0)$/ && $after =~ m/’s(?:\x20|\xc2\xa0|;.|,.|[\!\?\.\:])/ ) # … is an apostrophe-s (curly so its not markup!)
50              
51             ) {
52 56         71 ${$string_sr} =~ s/(\Q$bn\E)/“$1”/;
  56         962  
53 56         119 $has_bare++;
54             }
55             }
56              
57             # Do not hardcode URL in [output,url]:
58 150 100 100     709 if ( $piece->{'list'}[0] eq 'output' && $piece->{'list'}[1] eq 'url' ) {
59 32 100       300 if ( $piece->{'list'}[2] !~ m/\A$bn_var_rexep\z/ ) {
60 16         26 my $last_idx_bn = @{ $piece->{'list'} } - 1;
  16         33  
61 16         33 my $url = $piece->{'list'}[2];
62 16 100       19 my $args = @{ $piece->{'list'} } > 3 ? ',' . join( ',', @{ $piece->{'list'} }[ 3 .. $last_idx_bn ] ) : '';
  16         61  
  8         29  
63              
64 16         24 ${$string_sr} =~ s/(\Q$bn\E)/\[output,url,why hardcode “$url”$args\]/;
  16         254  
65 16         51 $has_hardurl++;
66             }
67             }
68             }
69              
70 98 100       294 $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;
71 98 100       287 $filter->add_warning('Bare variable can lead to ambiguous output') if $has_bare;
72              
73 98         323 return $filter->return_value;
74             }
75              
76             1;
77              
78             __END__