line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Text::Extract::MaketextCallPhrases; |
2
|
|
|
|
|
|
|
|
3
|
8
|
|
|
8
|
|
157013
|
use strict; |
|
8
|
|
|
|
|
17
|
|
|
8
|
|
|
|
|
290
|
|
4
|
8
|
|
|
8
|
|
39
|
use warnings; |
|
8
|
|
|
|
|
12
|
|
|
8
|
|
|
|
|
368
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
$Text::Extract::MaketextCallPhrases::VERSION = '0.93'; |
7
|
|
|
|
|
|
|
|
8
|
8
|
|
|
8
|
|
6500
|
use Text::Balanced (); |
|
8
|
|
|
|
|
121689
|
|
|
8
|
|
|
|
|
262
|
|
9
|
8
|
|
|
8
|
|
3403
|
use String::Unquotemeta (); |
|
8
|
|
|
|
|
1629
|
|
|
8
|
|
|
|
|
176
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
# So we don't have to maintain an identical regex |
12
|
8
|
|
|
8
|
|
3449
|
use Module::Want 0.6 (); |
|
8
|
|
|
|
|
6475
|
|
|
8
|
|
|
|
|
296
|
|
13
|
|
|
|
|
|
|
my $ns_regexp = Module::Want::get_ns_regexp(); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub import { |
16
|
8
|
|
|
8
|
|
46
|
no strict 'refs'; ## no critic |
|
8
|
|
|
|
|
10
|
|
|
8
|
|
|
|
|
20257
|
|
17
|
8
|
|
|
8
|
|
84
|
*{ caller() . '::get_phrases_in_text' } = \&get_phrases_in_text; |
|
8
|
|
|
|
|
71
|
|
18
|
8
|
|
|
|
|
17
|
*{ caller() . '::get_phrases_in_file' } = \&get_phrases_in_file; |
|
8
|
|
|
|
|
7740
|
|
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
my $default_regexp_conf_item = [ |
22
|
|
|
|
|
|
|
qr/(?:(?:^|\:|\s|=|\(|\.|\b)translatable|(?:make|lex)text(?:_[a-zA-Z0-9_]+_context)?)\s*\(?/, |
23
|
|
|
|
|
|
|
sub { return substr( $_[0], -1, 1 ) eq '(' ? qr/\s*\)/ : qr/\s*\;/ }, |
24
|
|
|
|
|
|
|
]; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub get_phrases_in_text { |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# 3rd arg is used internally to get the line number in the 'debug_ignored_matches' results when called via get_phrases_in_file(). Don't rely on this as it may change. |
29
|
58
|
|
|
58
|
1
|
228746
|
my ( $text, $conf_hr, $linenum ) = @_; # 3rd arg is used internally to get the line number in the 'debug_ignored_matches' results when called via get_phrases_in_file(). Don't rely on this as it may change. |
30
|
|
|
|
|
|
|
|
31
|
58
|
|
100
|
|
|
257
|
$conf_hr ||= {}; |
32
|
|
|
|
|
|
|
|
33
|
58
|
50
|
|
|
|
160
|
if ( $conf_hr->{'encode_unicode_slash_x'} ) { |
34
|
0
|
0
|
|
|
|
0
|
Module::Want::have_mod('Encode') || die $@; |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
58
|
100
|
66
|
|
|
183
|
if ( $conf_hr->{'cpanel_mode'} && $conf_hr->{'cpanel_mode'} != 0 ) { |
38
|
1
|
|
|
|
|
2
|
$conf_hr->{'cpanel_mode'} = '0E0'; |
39
|
1
|
|
|
|
|
2
|
push @{ $conf_hr->{'regexp_conf'} }, [ qr/\/ ], [ qr/(?:^|[^<])cptext\s*\(/, qr/\s*\)/ ], [ qr/Cpanel::Exception(?:::$ns_regexp)?->new\(/, qr/\s*\)/ ], [ qr/Cpanel::Exception(?:::$ns_regexp)?::create\(/, qr/\s*\)/, { 'optional' => 1, 'arg_position' => 2 } ], [ qr/Cpanel::Exception(?:::$ns_regexp)?\-\>create\(/, qr/\s*\)/, { 'optional' => 1 } ]; |
|
1
|
|
|
|
|
91
|
|
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
58
|
|
|
|
|
70
|
my @results; |
43
|
|
|
|
|
|
|
my %offset_seen; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# I like this alignment better than what tidy does, seems clearer to me even if a bit overkill perhaps |
46
|
|
|
|
|
|
|
#tidyoff |
47
|
58
|
100
|
|
|
|
170
|
for my $regexp ( |
|
10
|
100
|
|
|
|
28
|
|
48
|
|
|
|
|
|
|
$conf_hr->{'regexp_conf'} ? ( |
49
|
3
|
|
|
|
|
9
|
$conf_hr->{'no_default_regex'} ? @{ $conf_hr->{'regexp_conf'} } |
50
|
|
|
|
|
|
|
: ( $default_regexp_conf_item, @{ $conf_hr->{'regexp_conf'} } ) |
51
|
|
|
|
|
|
|
) |
52
|
|
|
|
|
|
|
: ($default_regexp_conf_item) |
53
|
|
|
|
|
|
|
) { |
54
|
|
|
|
|
|
|
#tidyon |
55
|
65
|
|
|
|
|
106
|
my $text_working_copy = $text; |
56
|
65
|
|
|
|
|
94
|
my $original_len = length($text_working_copy); |
57
|
|
|
|
|
|
|
|
58
|
65
|
100
|
66
|
|
|
318
|
my $rx_conf_hr = defined $regexp->[2] && ref( $regexp->[2] ) eq 'HASH' ? $regexp->[2] : { 'optional' => 0, 'arg_position' => 0 }; |
59
|
65
|
100
|
|
|
|
214
|
$rx_conf_hr->{arg_position} = exists $rx_conf_hr->{arg_position} ? int( abs( $rx_conf_hr->{arg_position} ) ) : 0; # if caller passes a non-numeric value this should warn, that is a feature! |
60
|
|
|
|
|
|
|
|
61
|
65
|
|
|
|
|
1398
|
my $token_rx = qr/($regexp->[0]|## no extract maketext)/; |
62
|
65
|
|
66
|
|
|
1024
|
while ( defined $text_working_copy && $text_working_copy =~ m/$token_rx/ ) { |
63
|
513
|
|
|
|
|
919
|
my $matched = $1; |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# we have a (possibly multiline) chunk w/ notation-not-preceeded-by-token that we should ignore |
66
|
513
|
100
|
|
|
|
854
|
if ( $matched eq '## no extract maketext' ) { |
67
|
4
|
|
|
|
|
28
|
$text_working_copy =~ s/.*## no extract maketext[^\n]*//; |
68
|
4
|
|
|
|
|
47
|
next; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
509
|
|
|
|
|
450
|
my $pre; |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# TODO: incorporate the \s* into results: 'post_token_ws' => $1 || '' ? |
74
|
509
|
|
|
|
|
5808
|
( $pre, $text_working_copy ) = split( m/$regexp->[0]\s*/, $text_working_copy, 2 ); # the \s* takes into account trailing WS that Text::Balanced ignores which then can throw off the offset |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# we have a token line that we should ignore |
77
|
509
|
100
|
|
|
|
1827
|
next if $text_working_copy =~ s/^[^\n]*## no extract maketext[^\n]*//; |
78
|
|
|
|
|
|
|
|
79
|
503
|
|
|
|
|
704
|
my $offset = $original_len - length($text_working_copy); |
80
|
|
|
|
|
|
|
|
81
|
503
|
|
|
|
|
373
|
my $phrase; |
82
|
503
|
|
|
|
|
1664
|
my $result_hr = { 'is_error' => 0, 'is_warning' => 0, 'offset' => $offset, 'regexp' => $regexp, 'matched' => $matched }; |
83
|
|
|
|
|
|
|
|
84
|
503
|
100
|
|
|
|
1001
|
if ( $conf_hr->{'ignore_perlish_comments'} ) { |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
# ignore matches in a comment |
87
|
6
|
100
|
100
|
|
|
28
|
if ( $pre =~ m/\#/ && $pre !~ m/[\n\r]$/ ) { |
88
|
2
|
|
|
|
|
9
|
my @lines = split( /[\n\r]+/, $pre ); |
89
|
|
|
|
|
|
|
|
90
|
2
|
100
|
|
|
|
7
|
if ( $lines[-1] =~ m/\#/ ) { |
91
|
1
|
|
|
|
|
2
|
$result_hr->{'type'} = 'comment'; |
92
|
1
|
50
|
|
|
|
2
|
$result_hr->{'line'} = $linenum if defined $linenum; |
93
|
1
|
|
|
|
|
2
|
push @{ $conf_hr->{'debug_ignored_matches'} }, $result_hr; |
|
1
|
|
|
|
|
8
|
|
94
|
1
|
|
|
|
|
23
|
next; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
# ignore functions named *$1 |
100
|
502
|
100
|
100
|
|
|
1758
|
if ( $text_working_copy =~ m/^\s*\{/ && $matched !~ m/\(\s*$/ ) { |
101
|
4
|
|
|
|
|
12
|
$result_hr->{'type'} = 'function'; |
102
|
4
|
50
|
|
|
|
10
|
$result_hr->{'line'} = $linenum if defined $linenum; |
103
|
4
|
|
|
|
|
4
|
push @{ $conf_hr->{'debug_ignored_matches'} }, $result_hr; |
|
4
|
|
|
|
|
10
|
|
104
|
4
|
|
|
|
|
54
|
next; |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# ignore assignments to things named *maketext |
108
|
498
|
100
|
|
|
|
1158
|
if ( $text_working_copy =~ m/^\s*=/ ) { |
109
|
2
|
|
|
|
|
4
|
$result_hr->{'type'} = 'assignment'; |
110
|
2
|
50
|
|
|
|
6
|
$result_hr->{'line'} = $linenum if defined $linenum; |
111
|
2
|
|
|
|
|
2
|
push @{ $conf_hr->{'debug_ignored_matches'} }, $result_hr; |
|
2
|
|
|
|
|
5
|
|
112
|
2
|
|
|
|
|
45
|
next; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
496
|
100
|
|
|
|
894
|
if ( $conf_hr->{'ignore_perlish_statement'} ) { |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
# ignore a statement named *maketext (e.g. goto &XYZ::maketext;) |
118
|
3
|
100
|
|
|
|
8
|
if ( $text_working_copy =~ m/^\s*;/ ) { |
119
|
1
|
|
|
|
|
1
|
$result_hr->{'type'} = 'statement'; |
120
|
1
|
50
|
|
|
|
3
|
$result_hr->{'line'} = $linenum if defined $linenum; |
121
|
1
|
|
|
|
|
1
|
push @{ $conf_hr->{'debug_ignored_matches'} }, $result_hr; |
|
1
|
|
|
|
|
2
|
|
122
|
1
|
|
|
|
|
13
|
next; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
# phrase is argument N (instead of first) |
127
|
495
|
100
|
|
|
|
941
|
if ( $rx_conf_hr->{'arg_position'} > 0 ) { |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# hack away the args before the one at $arg_position |
130
|
25
|
|
|
|
|
43
|
for my $at_index ( 1 .. $rx_conf_hr->{'arg_position'} ) { |
131
|
55
|
|
|
|
|
1981
|
$text_working_copy =~ s{^\s*\,\s*}{}; |
132
|
55
|
100
|
|
|
|
113
|
if ( $at_index >= $rx_conf_hr->{'arg_position'} ) { |
133
|
25
|
|
|
|
|
57
|
$result_hr->{'offset'} = $original_len - length($text_working_copy); |
134
|
25
|
|
|
|
|
36
|
last; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
30
|
|
|
|
|
66
|
( $phrase, $text_working_copy ) = Text::Balanced::extract_variable($text_working_copy); |
138
|
|
|
|
|
|
|
|
139
|
30
|
50
|
|
|
|
830
|
if ( !defined $phrase ) { |
140
|
30
|
|
|
|
|
50
|
( $phrase, $text_working_copy ) = Text::Balanced::extract_quotelike($text_working_copy); |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
495
|
|
|
|
|
1123
|
( $phrase, $text_working_copy ) = Text::Balanced::extract_variable($text_working_copy); |
146
|
495
|
100
|
|
|
|
21249
|
my $optional_perlish = |
|
|
100
|
|
|
|
|
|
147
|
|
|
|
|
|
|
$text_working_copy =~ m/^\s*\[/ ? "ARRAY" |
148
|
|
|
|
|
|
|
: $text_working_copy =~ m/^\s*\{/ ? "HASH" |
149
|
|
|
|
|
|
|
: 0; |
150
|
|
|
|
|
|
|
|
151
|
495
|
100
|
|
|
|
750
|
if ( !$phrase ) { |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# undef $@; |
154
|
465
|
|
|
|
|
392
|
my ( $type, $inside, $opener, $closer ); |
155
|
465
|
|
|
|
|
891
|
( $phrase, $text_working_copy, undef, $type, $opener, $inside, $closer ) = Text::Balanced::extract_quotelike($text_working_copy); |
156
|
465
|
50
|
|
|
|
39842
|
$text_working_copy = '' if !defined $text_working_copy; |
157
|
|
|
|
|
|
|
|
158
|
465
|
100
|
100
|
|
|
3010
|
$result_hr->{'quotetype'} = 'single' if ( defined $opener && $opener eq "'" ) || ( defined $type && ( $type eq 'q' || $type eq 'qw' ) ); |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
159
|
465
|
100
|
100
|
|
|
2473
|
$result_hr->{'quotetype'} = 'double' if ( defined $opener && $opener eq '"' ) || ( defined $type && $type eq 'qq' ); |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
160
|
465
|
100
|
|
|
|
837
|
if ( $result_hr->{'quotetype'} ) { |
161
|
286
|
|
|
|
|
485
|
$result_hr->{'quote_before'} = $type . $opener; |
162
|
286
|
|
|
|
|
604
|
$result_hr->{'quote_after'} = $closer; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
465
|
100
|
100
|
|
|
1386
|
if ( defined $type && $type eq '<<' ) { |
166
|
22
|
|
|
|
|
53
|
$result_hr->{'quote_before'} = $type . $opener; |
167
|
22
|
|
|
|
|
31
|
$result_hr->{'quote_after'} = $closer; |
168
|
|
|
|
|
|
|
|
169
|
22
|
|
|
|
|
41
|
$result_hr->{'heredoc'} = $opener; |
170
|
22
|
100
|
|
|
|
46
|
if ( substr( $opener, 0, 1 ) eq "'" ) { |
171
|
19
|
|
|
|
|
28
|
$result_hr->{'quotetype'} = 'single'; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
else { |
174
|
3
|
|
|
|
|
4
|
$result_hr->{'quotetype'} = 'double'; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
465
|
100
|
100
|
|
|
2881
|
if ( defined $inside && ( exists $result_hr->{'quotetype'} ) && $inside eq '' ) { |
|
|
100
|
100
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
179
|
30
|
|
|
|
|
40
|
$result_hr->{'is_error'} = 1; |
180
|
30
|
|
|
|
|
36
|
$result_hr->{'type'} = 'empty'; |
181
|
30
|
|
|
|
|
43
|
$phrase = $inside; |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
elsif ( defined $inside && $inside ) { |
184
|
320
|
|
|
|
|
402
|
$phrase = $inside; |
185
|
|
|
|
|
|
|
|
186
|
320
|
100
|
100
|
|
|
3138
|
if ( $type eq 'qw' ) { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
187
|
21
|
100
|
|
|
|
72
|
if ( $phrase =~ m/\A(\s+)/ ) { |
188
|
2
|
|
|
|
|
4
|
$result_hr->{'quote_before'} .= $1; |
189
|
2
|
|
|
|
|
5
|
$phrase =~ s/\A(\s+)//; |
190
|
|
|
|
|
|
|
} |
191
|
21
|
100
|
|
|
|
82
|
if ( $phrase =~ m/(\s+)\z/ ) { |
192
|
2
|
|
|
|
|
5
|
$result_hr->{'quote_after'} = $1 . $result_hr->{'quote_after'}; |
193
|
2
|
|
|
|
|
5
|
$phrase =~ s/(\s+)\z//; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
21
|
100
|
|
|
|
69
|
if ( $phrase =~ m/(\s+)/ ) { |
197
|
19
|
|
|
|
|
45
|
$result_hr->{'quote_after'} = $1; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
# otherwise leave quote_after asis for cases like this: qw(foo) |
201
|
|
|
|
|
|
|
|
202
|
21
|
|
|
|
|
63
|
($phrase) = split( /\s+/, $phrase, 2 ); |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
elsif ( $type eq 'qx' || $opener eq '`' ) { |
205
|
12
|
|
|
|
|
16
|
$result_hr->{'is_warning'} = 1; |
206
|
12
|
|
|
|
|
28
|
$result_hr->{'type'} = 'command'; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
elsif ( $type eq 'm' || $type eq 'qr' || $type eq 's' || $type eq 'tr' || $opener eq '/' ) { |
209
|
30
|
|
|
|
|
38
|
$result_hr->{'is_warning'} = 1; |
210
|
30
|
|
|
|
|
50
|
$result_hr->{'type'} = 'pattern'; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
elsif ( defined $opener && defined $inside && defined $closer && defined $phrase && $phrase eq "$opener$inside$closer" ) { |
214
|
0
|
|
|
|
|
0
|
$result_hr->{'is_error'} = 1; |
215
|
0
|
|
|
|
|
0
|
$result_hr->{'type'} = 'empty'; |
216
|
0
|
|
|
|
|
0
|
$phrase = $inside; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
else { |
219
|
115
|
|
|
|
|
106
|
my $is_no_arg = 0; |
220
|
115
|
50
|
|
|
|
226
|
if ( defined $regexp->[1] ) { |
221
|
115
|
100
|
|
|
|
263
|
if ( ref( $regexp->[1] ) eq 'CODE' ) { |
|
|
50
|
|
|
|
|
|
222
|
89
|
|
|
|
|
164
|
my $rgx = $regexp->[1]->($matched); |
223
|
89
|
100
|
|
|
|
1186
|
if ( $text_working_copy =~ m/^$rgx/ ) { |
224
|
37
|
|
|
|
|
85
|
$is_no_arg = 1; |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
elsif ( ref( $regexp->[1] ) eq 'Regexp' ) { |
228
|
26
|
|
|
|
|
122
|
my $rgx = qr/^$regexp->[1]/; |
229
|
26
|
100
|
|
|
|
129
|
if ( $text_working_copy =~ $rgx ) { |
230
|
15
|
|
|
|
|
29
|
$is_no_arg = 1; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
115
|
100
|
|
|
|
758
|
if ($is_no_arg) { |
|
|
100
|
|
|
|
|
|
236
|
52
|
100
|
|
|
|
105
|
if ( $rx_conf_hr->{'optional'} ) { |
237
|
13
|
|
|
|
|
124
|
next; |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
else { |
240
|
39
|
|
|
|
|
49
|
$result_hr->{'is_error'} = 1; |
241
|
39
|
|
|
|
|
72
|
$result_hr->{'type'} = 'no_arg'; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
elsif ( $text_working_copy =~ m/^\s*(((?:\&|\\\*)?)$ns_regexp(?:\-\>$ns_regexp)?((?:\s*\()?))/o ) { |
245
|
44
|
|
|
|
|
86
|
$phrase = $1; |
246
|
44
|
100
|
66
|
|
|
186
|
my $perlish = $2 || $3 ? 1 : 0; |
247
|
|
|
|
|
|
|
|
248
|
44
|
|
|
|
|
486
|
$text_working_copy =~ s/\s*(?:\&|\\\*)?$ns_regexp(?:\-\>$ns_regexp)?(?:\s*\()?\s*//o; |
249
|
|
|
|
|
|
|
|
250
|
44
|
|
|
|
|
82
|
$result_hr->{'is_warning'} = 1; |
251
|
44
|
100
|
|
|
|
126
|
$result_hr->{'type'} = $perlish ? 'perlish' : 'bareword'; |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
else { |
256
|
30
|
|
|
|
|
49
|
$result_hr->{'is_warning'} = 1; |
257
|
30
|
|
|
|
|
43
|
$result_hr->{'type'} = 'perlish'; |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
482
|
100
|
|
|
|
723
|
if ( !defined $phrase ) { |
261
|
58
|
|
|
|
|
58
|
my $is_no_arg = 0; |
262
|
58
|
50
|
|
|
|
118
|
if ( defined $regexp->[1] ) { |
263
|
58
|
100
|
|
|
|
124
|
if ( ref( $regexp->[1] ) eq 'CODE' ) { |
|
|
50
|
|
|
|
|
|
264
|
49
|
|
|
|
|
81
|
my $rgx = $regexp->[1]->($matched); |
265
|
49
|
100
|
|
|
|
626
|
if ( $text_working_copy =~ m/^$rgx/ ) { |
266
|
37
|
|
|
|
|
71
|
$is_no_arg = 1; |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
elsif ( ref( $regexp->[1] ) eq 'Regexp' ) { |
270
|
9
|
|
|
|
|
38
|
my $rgx = qr/^$regexp->[1]/; |
271
|
9
|
100
|
|
|
|
29
|
if ( $text_working_copy =~ $rgx ) { |
272
|
2
|
|
|
|
|
3
|
$is_no_arg = 1; |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
58
|
100
|
|
|
|
99
|
if ($is_no_arg) { |
278
|
39
|
50
|
|
|
|
77
|
if ( $rx_conf_hr->{'optional'} ) { |
279
|
0
|
|
|
|
|
0
|
next; |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
else { |
282
|
39
|
|
|
|
|
56
|
$result_hr->{'is_error'} = 1; |
283
|
39
|
|
|
|
|
58
|
$result_hr->{'type'} = 'no_arg'; |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
else { |
287
|
19
|
100
|
|
|
|
47
|
if ($optional_perlish) { |
288
|
7
|
100
|
|
|
|
14
|
if ( $rx_conf_hr->{'optional'} ) { |
289
|
3
|
|
|
|
|
30
|
next; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
else { |
292
|
4
|
|
|
|
|
6
|
$result_hr->{'is_warning'} = 1; |
293
|
4
|
|
|
|
|
5
|
$result_hr->{'type'} = 'perlish'; |
294
|
4
|
|
|
|
|
4
|
$phrase = $optional_perlish; |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
else { |
298
|
12
|
|
|
|
|
19
|
$result_hr->{'is_warning'} = 1; |
299
|
12
|
|
|
|
|
25
|
$result_hr->{'type'} = 'multiline'; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
else { |
304
|
424
|
|
|
|
|
602
|
$result_hr->{'original_text'} = $phrase; |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
# make sure its wasn't a tricky variable in quotes like maketext("$foo->{zip}") |
307
|
|
|
|
|
|
|
# '$foo->{zip}' ' $foo->{zip} ' " $foo->{zip} " to but that seems like a good idea to flag as wonky and in need of human follow up |
308
|
424
|
|
|
|
|
901
|
my ( $var, $for, $aft ) = Text::Balanced::extract_variable($phrase); |
309
|
424
|
100
|
66
|
|
|
17856
|
if ( $var && defined $for && defined $aft && $for =~ m/\A\s*\z/ && $aft =~ m/\A\s*\z/ ) { |
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
310
|
34
|
|
|
|
|
60
|
$result_hr->{'is_warning'} = 1; |
311
|
34
|
|
|
|
|
56
|
$result_hr->{'type'} = 'perlish'; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
else { |
314
|
390
|
100
|
|
|
|
789
|
if ( exists $result_hr->{'quotetype'} ) { |
315
|
304
|
100
|
|
|
|
647
|
if ( $result_hr->{'quotetype'} eq 'single' ) { |
|
|
50
|
|
|
|
|
|
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
# escape \n\t etc to preserver them during unquotemeta() |
318
|
206
|
|
|
|
|
359
|
$phrase =~ s{(\\(?:n|t|f|r|a|b))}{\\$1}g; |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
elsif ( $result_hr->{'quotetype'} eq 'double' ) { |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
# interpolate \n\t etc |
323
|
98
|
|
|
|
|
202
|
$phrase =~ s{(\\(?:n|t|f|r|a|b))}{eval qq{"$1"}}eg; |
|
6
|
|
|
|
|
453
|
|
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
|
327
|
390
|
50
|
|
|
|
586
|
if ( $conf_hr->{'encode_unicode_slash_x'} ) { |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
# Turn Unicode string \x{} into bytes strings |
330
|
0
|
|
|
|
|
0
|
$phrase =~ s{(\\x\{[0-9a-fA-F]+\})}{Encode::encode_utf8( eval qq{"$1"} )}eg; |
|
0
|
|
|
|
|
0
|
|
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
else { |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
# Preserve Unicode string \x{} for unquotemeta() |
335
|
390
|
|
|
|
|
529
|
$phrase =~ s{(\\)(x\{[0-9a-fA-F]+\})}{$1$1$2}g; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
# Turn graphemes into characters to avoid quotemeta() problems |
339
|
390
|
|
|
|
|
412
|
$phrase =~ s{((:?\\x[0-9a-fA-F]{2})+)}{eval qq{"$1"}}eg; |
|
2
|
|
|
|
|
152
|
|
340
|
390
|
100
|
100
|
|
|
1626
|
$phrase = String::Unquotemeta::unquotemeta($phrase) unless exists $result_hr->{'type'} && $result_hr->{'type'} eq 'perlish'; |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
479
|
|
|
|
|
2961
|
$result_hr->{'phrase'} = $phrase; |
345
|
|
|
|
|
|
|
|
346
|
479
|
50
|
|
|
|
10507
|
push @results, $result_hr if ++$offset_seen{ $result_hr->{'offset'} } == 1; |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
|
350
|
58
|
|
|
|
|
270
|
return [ sort { $a->{'offset'} <=> $b->{'offset'} } @results ]; |
|
478
|
|
|
|
|
797
|
|
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
sub get_phrases_in_file { |
354
|
1
|
|
|
1
|
1
|
2199
|
my ( $file, $regex_conf ) = @_; |
355
|
|
|
|
|
|
|
|
356
|
1
|
50
|
|
|
|
31
|
open my $fh, '<', $file or return; |
357
|
|
|
|
|
|
|
|
358
|
1
|
|
|
|
|
1
|
my @results; |
359
|
1
|
|
|
|
|
1
|
my $prepend = ''; |
360
|
1
|
|
|
|
|
2
|
my $linenum = 0; |
361
|
1
|
|
|
|
|
2
|
my $in_multi_line = 0; |
362
|
1
|
|
|
|
|
1
|
my $line; # buffer |
363
|
|
|
|
|
|
|
|
364
|
1
|
|
|
|
|
10
|
while ( $line = readline($fh) ) { |
365
|
12
|
|
|
|
|
7
|
$linenum++; |
366
|
|
|
|
|
|
|
|
367
|
12
|
|
|
|
|
11
|
my $initial_result_count = @results; |
368
|
12
|
100
|
|
|
|
13
|
push @results, map { $_->{'file'} = $file; $_->{'line'} = $in_multi_line ? $in_multi_line : $linenum; $_ } @{ get_phrases_in_text( $prepend . $line, $regex_conf, $linenum ) }; |
|
9
|
|
|
|
|
18
|
|
|
9
|
|
|
|
|
15
|
|
|
9
|
|
|
|
|
13
|
|
|
12
|
|
|
|
|
24
|
|
369
|
12
|
|
|
|
|
16
|
my $updated_result_count = @results; |
370
|
|
|
|
|
|
|
|
371
|
12
|
50
|
66
|
|
|
113
|
if ( $in_multi_line && $updated_result_count == $initial_result_count ) { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
372
|
0
|
|
|
|
|
0
|
$prepend = $prepend . $line; |
373
|
0
|
|
|
|
|
0
|
next; |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
elsif ( $in_multi_line && $updated_result_count > $initial_result_count && $results[-1]->{'type'} ) { |
376
|
4
|
|
|
|
|
6
|
$prepend = $prepend . $line; |
377
|
4
|
|
|
|
|
3
|
pop @results; |
378
|
4
|
|
|
|
|
16
|
next; |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
elsif ( !$in_multi_line && @results && defined $results[-1]->{'type'} && $results[-1]->{'type'} eq 'multiline' ) { |
381
|
2
|
|
|
|
|
2
|
$in_multi_line = $linenum; |
382
|
2
|
|
|
|
|
3
|
my $trailing_partial = pop @results; |
383
|
|
|
|
|
|
|
|
384
|
2
|
|
|
|
|
10
|
require bytes; |
385
|
2
|
50
|
|
|
|
8
|
my $offset = $trailing_partial->{'offset'} > bytes::length( $prepend . $line ) ? bytes::length( $prepend . $line ) : $trailing_partial->{'offset'}; |
386
|
2
|
|
|
|
|
9
|
$prepend = $trailing_partial->{'matched'} . substr( "$prepend$line", $offset ); |
387
|
2
|
|
|
|
|
9
|
next; |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
else { |
390
|
6
|
|
|
|
|
8
|
$in_multi_line = 0; |
391
|
6
|
|
|
|
|
22
|
$prepend = ''; |
392
|
|
|
|
|
|
|
} |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
1
|
|
|
|
|
7
|
close $fh; |
396
|
|
|
|
|
|
|
|
397
|
1
|
|
|
|
|
5
|
return \@results; |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
1; |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
__END__ |