File Coverage

blib/lib/Locale/TextDomain/OO/Extract/YAML.pm
Criterion Covered Total %
statement 49 50 98.0
branch 2 8 25.0
condition 2 5 40.0
subroutine 10 10 100.0
pod 3 3 100.0
total 66 76 86.8


line stmt bran cond sub pod time code
1             package Locale::TextDomain::OO::Extract::YAML; ## no critic (TidyCode)
2            
3 2     2   78813 use strict;
  2         14  
  2         72  
4 2     2   14 use warnings;
  2         5  
  2         61  
5 2     2   310 use Moo;
  2         7359  
  2         14  
6 2     2   1567 use MooX::Types::MooseLike::Base qw(ArrayRef Str);
  2         4787  
  2         165  
7 2     2   268 use namespace::autoclean;
  2         8885  
  2         14  
8            
9             our $VERSION = '2.011';
10            
11             extends qw(
12             Locale::TextDomain::OO::Extract::Base::RegexBasedExtractor
13             );
14             with qw(
15             Locale::TextDomain::OO::Extract::Role::File
16             );
17            
18             has filter => (
19             is => 'rw',
20             isa => ArrayRef[Str],
21             lazy => 1,
22             default => sub {[ 'all' ]},
23             );
24            
25             sub _filtered_start_rule {
26 4     4   8 my $self = shift;
27            
28 4         7 my %filter_of = map { $_ => 1 } @{ $self->filter };
  4         116  
  4         65  
29             my $list_if = sub {
30 16     16   34 my ( $key, @list ) = @_;
31             my $condition
32             = $filter_of{all} && ! $filter_of{"!$key"}
33 16   33     63 || $filter_of{$key};
34 16 50       64 return $condition ? @list : ();
35 4         22 };
36 4         19 my $hash_key_suffix = join "\n| ", (
37             $list_if->('Gettext', qr{ __ \b }xms),
38             $list_if->('Maketext::Loc', qr{ _loc \b }xms),
39             $list_if->('Gettext::Loc', qr{ _loc_ \b }xms),
40             $list_if->('BabelFish::Loc', qr{ _loc_b \b }xms),
41             );
42 4   50     15 $hash_key_suffix ||= '(?!)';
43            
44 4         189 return qr{
45             ^ [ -]*
46             (?: content | label | message | value )
47             (?:
48             $hash_key_suffix
49             )
50             [ ]* [:]
51             }xms;
52             }
53            
54             ## no critic (ComplexRegexes)
55             my $text_rule
56             = [
57             [
58             # '...'
59             qr{
60             [ ]*
61             [']
62             (
63             [^\\']* # normal text
64             (?: \\ . [^\\']* )* # maybe followed by escaped char and normal text
65             )
66             [']
67             }xms,
68             ],
69             'or',
70             [
71             # "..."
72             qr{
73             [ ]*
74             ["]
75             (
76             [^\\"]* # normal text
77             (?: \\ . [^\\"]* )* # maybe followed by escaped char and normal text
78             )
79             ["]
80             }xms,
81             ],
82             'or',
83             [
84             # ...
85             qr{
86             [ ]*
87             (
88             .*? # normal text
89             )
90             [ ]* $
91             }xms,
92             ],
93             ];
94            
95             my $rules = [
96             # content_loc: |
97             # text
98             # ...
99             [
100             'begin',
101             sub {
102             my $content_ref = shift;
103            
104             my $regex = qr{
105             ^ ( [ -]* )
106             (?: content | label | message | value ) _ (?: _ | loc_b? | loc )
107             [ ]* [:] [ ]* [|] [ ]* \n
108             }xms;
109             $content_ref
110             or return $regex;
111             # full match begins here
112             my $pos = pos ${$content_ref};
113             # begin of heredoc with |
114             my ( $full_match, $indent ) = ${$content_ref} =~ m{ \G ( $regex ) }xms
115             or return;
116             # get heredoc lines
117             pos ${$content_ref} = $pos + length $full_match;
118             $indent =~ tr{-}{ };
119             $indent .= q{ } x 2; # next indent level
120             $regex = qr{
121             ( [ ]* \n ) # empty line
122             | \Q$indent\E ( [^\n]* \n ) # text line
123             }xms;
124             my $heredoc = q{};
125             while ( ( $full_match, my ( $empty_line, $text_line ) ) = ${$content_ref} =~ m{ \G ( $regex ) }xms ) {
126             $heredoc .= $empty_line || $text_line;
127             pos ${$content_ref} += length $full_match;
128             }
129             chomp $heredoc;
130             # full match over all
131             $full_match = substr
132             ${$content_ref},
133             $pos,
134             ( pos ${$content_ref} ) - $pos;
135             # reset pos for alternatives
136             pos ${$content_ref} = $pos;
137            
138             return $full_match, $heredoc;
139             },
140             'end',
141             ],
142             'or',
143             # content_loc: 'text ...'
144             # label_loc_ : "text ..."
145             # message__ : text ...
146             # value__ : text ...
147             # all combinations left after _ and right to : are possible
148             [
149             'begin',
150             qr{
151             ^ [ -]*
152             (?: content | label | message | value ) _ (?: _ | loc_b? | loc )
153             [ ]* [:]
154             }xms,
155             'and',
156             $text_rule,
157             'end',
158             ],
159             ];
160            
161             # remove code after # on pos 1
162             sub preprocess {
163 4     4 1 9 my $self = shift;
164            
165 4         57 my $content_ref = $self->content_ref;
166            
167 4         22 ${$content_ref} =~ s{ \r? \n }{\n}xmsg;
  4         71  
168 4         8 ${$content_ref} =~ s{
  4         416  
169             # "text with #" # comment
170             (
171             ["]
172             [^\\"]* # normal text
173             (?: \\ . [^\\"]* )* # maybe followed by escaped char and normal text
174             ["]
175             ) [ ]* [#] [^\n]* ( \n | \z )
176             |
177             # 'text with #' # comment
178             (
179             [']
180             [^\\']* # normal text
181             (?: \\ . [^\\']* )* # maybe followed by escaped char and normal text
182             [']
183             ) [ ]* [#] [^\n]* ( \n | \z )
184             |
185             # simple comment line
186             [ ]* [#] [^\n]* ( \n | \z )
187             }{
188 0 0       0 $1 ? "$1$2"
    0          
189             : $3 ? "$3$4"
190             : $5
191             }xmsge;
192            
193 4         8 return;
194             }
195             ## use critic (ComplexRegexes)
196            
197             sub stack_item_mapping {
198 16     16 1 25 my $self = shift;
199            
200 16         26 my $match = $_->{match};
201 16 50       19 @{$match}
  16         32  
202             or return;
203            
204             $self->add_message({
205             reference => ( sprintf '%s:%s', $self->filename, $_->{line_number} ),
206             domain => $self->domain,
207 16         237 msgid => shift @{$match},
  16         556  
208             category => $self->category,
209             });
210            
211 16         44 return;
212             }
213            
214             sub extract {
215 4     4 1 2730 my $self = shift;
216            
217 4         12 $self->start_rule( $self->_filtered_start_rule );
218 4         209 $self->rules($rules);
219 4         155 $self->preprocess;
220 4         17 $self->SUPER::extract;
221 4         9 for ( @{ $self->stack } ) {
  4         51  
222 16         45 $self->stack_item_mapping;
223             }
224            
225 4         23 return $self;
226             }
227            
228             __PACKAGE__->meta->make_immutable;
229            
230             1;
231            
232             __END__