File Coverage

blib/lib/Locale/TextDomain/OO/Extract/TT.pm
Criterion Covered Total %
statement 82 100 82.0
branch 18 34 52.9
condition 3 8 37.5
subroutine 12 12 100.0
pod 4 4 100.0
total 119 158 75.3


line stmt bran cond sub pod time code
1             package Locale::TextDomain::OO::Extract::TT; ## no critic (TidyCode)
2            
3 2     2   111964 use strict;
  2         18  
  2         72  
4 2     2   13 use warnings;
  2         4  
  2         63  
5 2     2   11 use Carp qw(confess);
  2         5  
  2         102  
6 2     2   1081 use Moo;
  2         22807  
  2         10  
7 2     2   3936 use MooX::Types::MooseLike::Base qw(ArrayRef Str);
  2         13020  
  2         161  
8 2     2   946 use namespace::autoclean;
  2         26043  
  2         12  
9            
10             our $VERSION = '2.011';
11            
12             extends qw(
13             Locale::TextDomain::OO::Extract::Base::RegexBasedExtractor
14             );
15             with qw(
16             Locale::TextDomain::OO::Extract::Role::File
17             );
18            
19             has filter => (
20             is => 'rw',
21             isa => ArrayRef[Str],
22             lazy => 1,
23             default => sub {[ 'all' ]},
24             );
25            
26             sub _filtered_start_rule {
27 4     4   11 my $self = shift;
28            
29 4         11 my %filter_of = map { $_ => 1 } @{ $self->filter };
  4         127  
  4         83  
30             my $list_if = sub {
31 28     28   67 my ( $key, @list ) = @_;
32             my $condition
33             = $filter_of{all} && ! $filter_of{"!$key"}
34 28   33     130 || $filter_of{$key};
35 28 50       97 return $condition ? @list : ();
36 4         29 };
37 4         18 my $with_bracket = join "\n| ", (
38             $list_if->('Gettext', 'N? __ n? p? x?'),
39             $list_if->('Gettext::DomainAndCategory', 'N? __ d? c? n? p? x?'),
40             $list_if->('Gettext::Loc', 'N? loc_ n? p? x?'),
41             $list_if->('Gettext::Loc::DomainAndCategory', 'N? loc_ d? c? n? p? x?'),
42             $list_if->('BabelFish::Loc', 'N? loc_b p?'),
43             $list_if->('BabelFish::Loc::DomainAndCategory', 'N? loc_b d? c? p?'),
44             $list_if->('Maketext', 'l'),
45             );
46 4   50     17 $with_bracket ||= '(?!)';
47            
48 4         166 return qr{
49             \b
50             (?: $with_bracket ) \s* [(]
51             }xms;
52             }
53            
54             my $category_rule
55             = my $context_rule
56             = my $domain_rule
57             = my $domain_or_category_rule
58             = my $plural_rule
59             = my $singular_rule
60             = my $text_rule
61             = [
62             [
63             # 'text with 0 .. n escaped chars'
64             qr{
65             \s* ( ['] )
66             (
67             [^\\']* # normal text
68             (?: \\ . [^\\']* )* # maybe followed by escaped char and normal text
69             )
70             [']
71             }xms,
72             ],
73             'or',
74             [
75             # "text with 0 .. n escaped chars"
76             qr{
77             \s* ( ["] )
78             (
79             [^\\"]* # normal text
80             (?: \\ . [^\\"]* )* # maybe followed by escaped char and normal text
81             )
82             ["]
83             }xms,
84             ],
85             'or',
86             [
87             # q{text with 0 .. n {placeholders} and/or 0 .. n escaped chars}
88             ## no critic (EscapedMetacharacters)
89             qr{
90             \s* ( qq? \{ ) # q curly bracket quoted
91             (
92             (?:
93             [^\{\}\\] # normal text
94             | \\ . # escaped char
95             | \{ (?-1) \} # any pairs of curly brackets with the same stuff inside
96             )*
97             )
98             \} # end of quote
99             }xms,
100             ## use critic (EscapedMetacharacters)
101             ],
102             ];
103             my $comma_rule = qr{ \s* [,] }xms;
104             my $count_rule = qr{ \s* ( [^,)]+ ) }xms;
105             my $close_rule = qr{ \s* [,]? \s* ( [^)]* ) [)] }xms;
106            
107             my $rules = [
108             # loc_, __
109             [
110             'begin',
111             qr{ \b N? (?: loc_ | __ ) ( x? ) \s* [(] }xms,
112             'and',
113             $text_rule,
114             'and',
115             $close_rule,
116             'end',
117             ],
118             'or',
119             [
120             'begin',
121             qr{ \b N? (?: loc_ | __ ) ( n x? ) \s* [(] }xms,
122             'and',
123             $singular_rule,
124             'and',
125             $comma_rule,
126             'and',
127             $plural_rule,
128             'and',
129             $comma_rule,
130             'and',
131             $count_rule,
132             'and',
133             $close_rule,
134             'end',
135             ],
136             'or',
137             [
138             'begin',
139             qr{ \b N? (?: loc_ | __ ) ( p x? ) \s* [(] }xms,
140             'and',
141             $context_rule,
142             'and',
143             $comma_rule,
144             'and',
145             $text_rule,
146             'and',
147             $close_rule,
148             'end',
149             ],
150             'or',
151             [
152             'begin',
153             qr{ \b N? (?: loc_ | __ ) ( np x? ) \s* [(] }xms,
154             'and',
155             $context_rule,
156             'and',
157             $comma_rule,
158             'and',
159             $singular_rule,
160             'and',
161             $comma_rule,
162             'and',
163             $plural_rule,
164             'and',
165             $comma_rule,
166             'and',
167             $count_rule,
168             'and',
169             $close_rule,
170             'end',
171             ],
172            
173             # loc_d, __d
174             'or',
175             [
176             'begin',
177             qr{ \b N? (?: loc_ | __ ) ( d x? ) \s* [(] }xms,
178             'and',
179             $domain_rule,
180             'and',
181             $comma_rule,
182             'and',
183             $text_rule,
184             'and',
185             $close_rule,
186             'end',
187             ],
188             'or',
189             [
190             'begin',
191             qr{ \b N? (?: loc_ | __ ) ( dn x? ) \s* [(] }xms,
192             'and',
193             $domain_rule,
194             'and',
195             $comma_rule,
196             'and',
197             $singular_rule,
198             'and',
199             $comma_rule,
200             'and',
201             $plural_rule,
202             'and',
203             $comma_rule,
204             'and',
205             $count_rule,
206             'and',
207             $close_rule,
208             'end',
209             ],
210             'or',
211             [
212             'begin',
213             qr{ \b N? (?: loc_ | __ ) ( dp x? ) \s* [(] }xms,
214             'and',
215             $domain_rule,
216             'and',
217             $comma_rule,
218             'and',
219             $context_rule,
220             'and',
221             $comma_rule,
222             'and',
223             $text_rule,
224             'and',
225             $close_rule,
226             'end',
227             ],
228             'or',
229             [
230             'begin',
231             qr{ \b N? (?: loc_ | __ ) ( dnp x? ) \s* [(] }xms,
232             'and',
233             $domain_rule,
234             'and',
235             $comma_rule,
236             'and',
237             $context_rule,
238             'and',
239             $comma_rule,
240             'and',
241             $singular_rule,
242             'and',
243             $comma_rule,
244             'and',
245             $plural_rule,
246             'and',
247             $comma_rule,
248             'and',
249             $count_rule,
250             'and',
251             $close_rule,
252             'end',
253             ],
254            
255             # loc_c, __c
256             'or',
257             [
258             'begin',
259             qr{ \b N? (?: loc_ | __ ) ( c x? ) \s* [(] }xms,
260             'and',
261             $text_rule,
262             'and',
263             $comma_rule,
264             'and',
265             $category_rule,
266             'and',
267             $close_rule,
268             'end',
269             ],
270             'or',
271             [
272             'begin',
273             qr{ \b N? (?: loc_ | __ ) ( cn x? ) \s* [(] }xms,
274             'and',
275             $singular_rule,
276             'and',
277             $comma_rule,
278             'and',
279             $plural_rule,
280             'and',
281             $comma_rule,
282             'and',
283             $count_rule,
284             'and',
285             $comma_rule,
286             'and',
287             $category_rule,
288             'and',
289             $close_rule,
290             'end',
291             ],
292             'or',
293             [
294             'begin',
295             qr{ \b N? (?: loc_ | __ ) ( cp x? ) \s* [(] }xms,
296             'and',
297             $context_rule,
298             'and',
299             $comma_rule,
300             'and',
301             $text_rule,
302             'and',
303             $comma_rule,
304             'and',
305             $category_rule,
306             'and',
307             $close_rule,
308             'end',
309             ],
310             'or',
311             [
312             'begin',
313             qr{ \b N? (?: loc_ | __ ) ( cnp x? ) \s* [(] }xms,
314             'and',
315             $context_rule,
316             'and',
317             $comma_rule,
318             'and',
319             $singular_rule,
320             'and',
321             $comma_rule,
322             'and',
323             $plural_rule,
324             'and',
325             $comma_rule,
326             'and',
327             $count_rule,
328             'and',
329             $comma_rule,
330             'and',
331             $category_rule,
332             'and',
333             $close_rule,
334             'end',
335             ],
336            
337             # loc_dc, __dc
338             'or',
339             [
340             'begin',
341             qr{ \b N? (?: loc_ | __ ) ( dc x? ) \s* [(] }xms,
342             'and',
343             $domain_rule,
344             'and',
345             $comma_rule,
346             'and',
347             $text_rule,
348             'and',
349             $comma_rule,
350             'and',
351             $category_rule,
352             'and',
353             $close_rule,
354             'end',
355             ],
356             'or',
357             [
358             'begin',
359             qr{ \b N? (?: loc_ | __ ) ( dcn x? ) \s* [(] }xms,
360             'and',
361             $domain_rule,
362             'and',
363             $comma_rule,
364             'and',
365             $singular_rule,
366             'and',
367             $comma_rule,
368             'and',
369             $plural_rule,
370             'and',
371             $comma_rule,
372             'and',
373             $count_rule,
374             'and',
375             $comma_rule,
376             'and',
377             $category_rule,
378             'and',
379             $close_rule,
380             'end',
381             ],
382             'or',
383             [
384             'begin',
385             qr{ \b N? (?: loc_ | __ ) ( dcp x? ) \s* [(] }xms,
386             'and',
387             $domain_rule,
388             'and',
389             $comma_rule,
390             'and',
391             $context_rule,
392             'and',
393             $comma_rule,
394             'and',
395             $text_rule,
396             'and',
397             $comma_rule,
398             'and',
399             $category_rule,
400             'and',
401             $close_rule,
402             'end',
403             ],
404             'or',
405             [
406             'begin',
407             qr{ \b N? (?: loc_ | __ ) ( dcnp x? ) \s* [(] }xms,
408             'and',
409             $domain_rule,
410             'and',
411             $comma_rule,
412             'and',
413             $context_rule,
414             'and',
415             $comma_rule,
416             'and',
417             $singular_rule,
418             'and',
419             $comma_rule,
420             'and',
421             $plural_rule,
422             'and',
423             $comma_rule,
424             'and',
425             $count_rule,
426             'and',
427             $comma_rule,
428             'and',
429             $category_rule,
430             'and',
431             $close_rule,
432             'end',
433             ],
434            
435             # loc_b... (BabelFish)
436             'or',
437             [
438             'begin',
439             qr{ \b N? loc_b () \s* [(] }xms,
440             'and',
441             $text_rule,
442             'and',
443             $close_rule,
444             'end',
445             ],
446             'or',
447             [
448             'begin',
449             qr{ \b N? loc_b ( p ) \s* [(] }xms,
450             'and',
451             $context_rule,
452             'and',
453             $comma_rule,
454             'and',
455             $text_rule,
456             'and',
457             $close_rule,
458             'end',
459             ],
460             'or',
461             [
462             'begin',
463             qr{ \b N? loc_b ( d ) \s* [(] }xms,
464             'and',
465             $domain_rule,
466             'and',
467             $comma_rule,
468             'and',
469             $text_rule,
470             'and',
471             $close_rule,
472             'end',
473             ],
474             'or',
475             [
476             'begin',
477             qr{ \b N? loc_b ( dp ) \s* [(] }xms,
478             'and',
479             $domain_rule,
480             'and',
481             $comma_rule,
482             'and',
483             $context_rule,
484             'and',
485             $comma_rule,
486             'and',
487             $text_rule,
488             'and',
489             $close_rule,
490             'end',
491             ],
492             'or',
493             [
494             'begin',
495             qr{ \b N? loc_b ( c ) \s* [(] }xms,
496             'and',
497             $text_rule,
498             'and',
499             $comma_rule,
500             'and',
501             $category_rule,
502             'and',
503             $close_rule,
504             'end',
505             ],
506             'or',
507             [
508             'begin',
509             qr{ \b N? loc_b ( cp ) \s* [(] }xms,
510             'and',
511             $context_rule,
512             'and',
513             $comma_rule,
514             'and',
515             $text_rule,
516             'and',
517             $comma_rule,
518             'and',
519             $category_rule,
520             'and',
521             $close_rule,
522             'end',
523             ],
524             'or',
525             [
526             'begin',
527             qr{ \b N? loc_b ( dc ) \s* [(] }xms,
528             'and',
529             $domain_rule,
530             'and',
531             $comma_rule,
532             'and',
533             $text_rule,
534             'and',
535             $comma_rule,
536             'and',
537             $category_rule,
538             'and',
539             $close_rule,
540             'end',
541             ],
542             'or',
543             [
544             'begin',
545             qr{ \b N? loc_b ( dcp ) \s* [(] }xms,
546             $domain_rule,
547             'and',
548             $comma_rule,
549             'and',
550             $context_rule,
551             'and',
552             $comma_rule,
553             'and',
554             $text_rule,
555             'and',
556             $comma_rule,
557             'and',
558             $category_rule,
559             'and',
560             $close_rule,
561             'end',
562             ],
563            
564             # l (Maketext)
565             'or',
566             [
567             'begin',
568             qr{ \b l () \s* [(] }xms,
569             'and',
570             $text_rule,
571             'and',
572             $close_rule,
573             'end',
574             ]
575             ];
576            
577             # handle different newlines
578             sub preprocess {
579 4     4 1 10 my $self = shift;
580            
581 4         69 my $content_ref = $self->content_ref;
582            
583 4         27 ${$content_ref} =~ s{ \r? \n }{\n}xmsg;
  4         248  
584            
585             # replace heredoc's without killing the line number
586             # <<'...'
587             REPLACE: {
588 4 50       13 ${$content_ref} =~ s{
  4         7  
  4         61  
589             << \s* ' ( \w+ ) ' ( [^\n]* ) \n
590             ( .*? )
591             ^ \1 $
592             }
593             {
594 0         0 qq{\n'}
  0         0  
  0         0  
  0         0  
595             . do { my $text = $3; $text =~ s{'}{\\'}xmsg; $text }
596             . q{'}
597             . $2
598             }xmsge and redo REPLACE;
599             }
600             # <<...
601             # <<"..."
602 4 50       8 REPLACE: {
  4         9  
  4         53  
603             ${$content_ref} =~ s{
604             << \s* ( ["]? ) ( \w+ ) \1 ( [^\n]* ) \n
605             ( .*? )
606             ^ \2 $
607             }
608 0         0 {
  0         0  
  0         0  
  0         0  
609             qq{\n"}
610             . do { my $text = $4; $text =~ s{"}{\\"}xmsg; $text }
611             . q{"}
612             . $3
613             }xmsge and redo REPLACE;
614 4         12 }
615            
616             return $self;
617             }
618 78     78 1 187
619             sub interpolate_escape_sequence {
620             my ( undef, $string, $quot ) = @_;
621 78 50       169
622             # nothing to interpolate
623 78 50       159 defined $string
624             or return $string;
625             defined $quot
626 78   33     252 or confess 'Quote expected';
627 78 50       169
628             my $is_interpolate = $quot eq q{"} || $quot eq 'qq{';
629 78 50       159 if ( ! $is_interpolate ) {
630 78         156 # '...'
631 78         727 if ( $quot eq q{'} ) {
632             $string =~ s{ \\ ( ['] ) }{$1}xmsg;
633             return $string;
634 0 0       0 }
635 0         0 # q{...}
636 0         0 if ( $quot eq 'q{' ) {
637             $string =~ s{ \\ ( [\{\}] ) }{$1}xmsg; ## no critic (EscapedMetacharacters)
638 0         0 return $string;
639             }
640             confess "Unknown quot $quot";
641             }
642            
643 0         0 # "..."
644             # qq{...}
645             my %char_of = (
646             b => "\b",
647             f => "\f",
648             n => "\n",
649             r => "\r",
650 0         0 t => "\t",
651             );
652             $string =~ s{
653             \\
654             (?:
655             ( [bfnrt] ) # Backspace
656             # Form feed
657             # New line
658             # Carriage return
659             # Horizontal tab
660             | ( [xN] ) # do not handle \x.., \x{...}, \N{...}
661             | (.) # Backslash itself
662             # Single quotation mark
663             # Double quotation mark
664             # anything else that needs no escape
665 0 0       0 )
    0          
666             }{
667             $1 ? $char_of{$1}
668             : $2 ? "\\$2"
669             : $3
670 0         0 }xmsge;
671            
672             return $string;
673             }
674 46     46 1 86
675             sub stack_item_mapping {
676 46         89 my $self = shift;
677            
678 46         68 my $match = $_->{match};
  46         93  
679 46 50       81 # The chars e.g. after loc_ were stored to make a decision now.
  46         104  
680             my $extra_parameter = shift @{$match};
681             @{$match}
682 46         77 or return;
683            
684             my $count;
685             $self->add_message({
686             reference => ( sprintf '%s:%s', $self->filename, $_->{line_number} ),
687 0         0 domain => $extra_parameter =~ m{ d }xms
688             ? scalar $self->interpolate_escape_sequence(
689             reverse splice @{$match}, 0, 2
690             )
691             : $self->domain,
692 16         499 msgctxt => $extra_parameter =~ m{ p }xms
693             ? scalar $self->interpolate_escape_sequence(
694             reverse splice @{$match}, 0, 2
695             )
696 46         1041 : undef,
697             msgid => scalar $self->interpolate_escape_sequence(
698             reverse splice @{$match}, 0, 2
699             ),
700             msgid_plural => $extra_parameter =~ m{ n }xms
701 16         30 ? do {
  16         36  
702             my $plural = $self->interpolate_escape_sequence(
703 16         34 reverse splice @{$match}, 0, 2
  16         34  
704 16         305 );
705             $count = shift @{$match};
706             $plural;
707             }
708             : undef,
709 0         0 category => $extra_parameter =~ m{ c }xms
710             ? scalar $self->interpolate_escape_sequence(
711             reverse splice @{$match}, 0, 2
712 46 50       891 )
    100          
    100          
    50          
713 46         283 : $self->category,
  46         100  
714             automatic => do {
715 46         98 my $placeholders = shift @{$match};
716 92 100       187 my $string = join ', ', map { ## no critic (MutatingListFunctions)
717 62         218 defined $_
718 62         177 ? do {
719 62 100       255 s{ \s+ }{ }xmsg;
720             s{ \s+ \z }{}xms;
721             length $_ ? $_ : ();
722             }
723 46         93 : ();
724 46         324 } ( $count, $placeholders );
725             $string =~ s{ \A ( .{70} ) .+ \z }{$1 ...}xms;
726             $string;
727             },
728 46         184 });
729            
730             return;
731             }
732 4     4 1 5303
733             sub extract {
734 4         30 my $self = shift;
735 4         279
736 4         204 $self->start_rule( $self->_filtered_start_rule );
737 4         25 $self->rules($rules);
738 4         11 $self->preprocess;
  4         72  
739 46         130 $self->SUPER::extract;
740             for ( @{ $self->stack } ) {
741             $self->stack_item_mapping;
742 4         46 }
743            
744             return $self;
745             }
746            
747             __PACKAGE__->meta->make_immutable;
748            
749             1;
750            
751             __END__