File Coverage

blib/lib/Locale/TextDomain/OO/Extract/Xslate.pm
Criterion Covered Total %
statement 104 132 78.7
branch 36 48 75.0
condition 46 108 42.5
subroutine 16 16 100.0
pod 1 1 100.0
total 203 305 66.5


line stmt bran cond sub pod time code
1             package Locale::TextDomain::OO::Extract::Xslate;
2             $Locale::TextDomain::OO::Extract::Xslate::VERSION = '0.04';
3             # vim:syntax=perl:tabstop=4:number:expandtab:
4              
5             # ABSTRACT: Extract messages from Text::Xslate templates for translation with Locale::TextDomain::OO
6              
7 3     3   66157 use strict;
  3         18  
  3         88  
8 3     3   15 use warnings;
  3         6  
  3         75  
9 3     3   1574 use Moo;
  3         35947  
  3         15  
10 3     3   6871 use Path::Tiny;
  3         42213  
  3         178  
11 3     3   1483 use namespace::autoclean;
  3         38867  
  3         13  
12              
13             with qw( Locale::TextDomain::OO::Extract::Role::File );
14              
15             has 'debug' => (
16             is => 'rw',
17             default => 0,
18             );
19              
20             has 'syntax' => (
21             is => 'ro',
22             default => 'Kolon',
23             );
24              
25             has 'parser' => (
26             is => 'lazy',
27             init_arg => undef,
28             );
29              
30             has 'l10n_function_re' => (
31             is => 'ro',
32             default => sub {
33             qr{\A
34             N?
35             (?:loc|_)
36             _
37             (x|n|nx|p|px|np|npx)?
38             \Z
39             }x
40             },
41             );
42              
43             has 'addl_l10n_function_re' => ( is => 'rw', );
44              
45              
46             sub _build_parser {
47 7     7   92 my $self = shift;
48 7         31 my $syntax = $self->syntax;
49 7     2   610 eval "use Text::Xslate::Syntax::${syntax};";
  2     2   992  
  2     1   125203  
  2     1   52  
  2     1   18  
  2         6  
  2         38  
  1         10  
  1         3  
  1         20  
  1         10  
  1         3  
  1         19  
  1         8  
  1         3  
  1         17  
50 7 50       41 die $@ if $@;
51 7         104 "Text::Xslate::Syntax::${syntax}"->new();
52             }
53              
54              
55             sub extract {
56 13     13 1 12615 my $self = shift;
57 13         35 my $messages = [];
58 13         207 my $filename = $self->filename;
59 13         118 $self->_scan_file( $messages, $filename );
60              
61 13         444 my ( $cat, $dom ) = ( $self->category, $self->domain );
62 13         393 foreach my $msg ( @{$messages} ) {
  13         43  
63             $self->add_message(
64             {
65             category => ( $cat // '' ),
66             domain => ( $dom // '' ),
67             msgctxt => ( $msg->{'MSGCTXT'} // '' ),
68             msgid => ( $msg->{'MSGID'} // '' ),
69             msgid_plural => ( $msg->{'MSGID_PLURAL'} // '' ),
70 51   50     5573 reference => sprintf( '%s:%s', $msg->{'FILE'}, $msg->{'LINE'} ),
      50        
      100        
      50        
      100        
71              
72             # automatic => 'my automatic comment',
73             }
74             );
75             }
76             }
77              
78             our $RESULT;
79             our $FILENAME;
80              
81              
82             sub _scan {
83 13     13   76 my ( $self, $result, $filename, $data ) = @_;
84 13         332 my $ast = $self->parser->parse( $data );
85 13         202419 local $FILENAME = $filename;
86 13         37 local $RESULT = $result;
87 13         60 $self->_walker( $ast );
88 13         930 return $result;
89             }
90              
91              
92             sub _scan_file {
93 13     13   43 my ( $self, $result, $filename ) = @_;
94 13         50 my $data = path( $filename )->slurp_utf8;
95 13         4870 return $self->_scan( $result, $filename, $data );
96             }
97              
98             my $sp = '';
99              
100              
101             sub _walker {
102 2593     2593   4368 my ( $self, $ast ) = @_;
103 2593 100 100     5838 $ast = [$ast] if $ast && ref( $ast ) eq 'Text::Xslate::Symbol';
104 2593 100 66     5978 return unless $ast && ref( $ast ) eq 'ARRAY';
105              
106 524         991 my $l10n_fns = $self->l10n_function_re;
107 524 100       1093 if ( my $addl_l10n_fns = $self->addl_l10n_function_re ) {
108 98         566 $l10n_fns = qr{
109             (?: $l10n_fns )
110             |
111             (?: \A N? $addl_l10n_fns \z )
112             }x;
113             }
114              
115 524         823 for my $sym ( @{$ast} ) {
  524         967  
116              
117 870 100       1767 next if ref $sym eq 'ARRAY';
118              
119 869 100 66     3821 if ( $sym->arity eq 'methodcall' && $sym->value eq '.' ) {
    100 66        
      66        
      66        
120 23         61 my $second = $sym->second;
121 23 50 33     107 if ( $second && ref( $second ) eq 'Text::Xslate::Symbol' ) {
122 23 100 66     310 if ( $second->arity eq 'literal'
123             && $second->value =~ $l10n_fns )
124             {
125 17   100     78 my $flags = ( $1 || '' );
126 17         54 my $third = $sym->third;
127 17 100 33     216 if ( $third
    50 33        
      33        
      66        
128             && ref( $third ) eq 'ARRAY'
129             && $third->[0]
130             && ref( $third->[0] ) eq 'Text::Xslate::Symbol'
131             && $third->[0]->arity !~ /^(?: variable | methodcall | field )$/x )
132             {
133 14         84 my %msg = ( FILE => $FILENAME, LINE => $second->line, FLAGS => $flags, );
134 14 50       40 if ( _parseMsg( \%msg, $flags, $third ) ) {
135 14         24 push @{$RESULT}, \%msg;
  14         46  
136             }
137             else {
138 0         0 warn "Invalid parameters for translation command at '$FILENAME', line " . $second->line;
139             }
140             }
141             elsif ( $third->[0]->arity =~ /^(?: variable | methodcall | field )$/x ) {
142 3         10 next; # skip __($foo), __($foo.bar): nothing to do
143             }
144             else {
145 0         0 warn "Invalid parameters for translation command at '$FILENAME', line " . $second->line;
146             }
147             }
148             }
149             }
150             elsif (
151             $sym->arity eq 'call'
152             && defined $sym->value
153             &&
154              
155             # __x("foo") "foo" | __x
156             ( $sym->value eq '(' or $sym->value eq '(call)' )
157             )
158             {
159 46         130 my $first = $sym->first;
160 46 50 33     215 if ( $first && ref( $first ) eq 'Text::Xslate::Symbol' ) {
161 46 100 66     598 if ( $first->arity eq 'name'
162             && $first->value =~ $l10n_fns )
163             {
164 43   100     189 my $flags = ( $1 || '' );
165 43         108 my $second = $sym->second;
166 43 100 33     479 if ( $second
    50 33        
      33        
      66        
167             && ref( $second ) eq 'ARRAY'
168             && $second->[0]
169             && ref( $second->[0] ) eq 'Text::Xslate::Symbol'
170             && $second->[0]->arity !~ /^(?: variable | methodcall | field )$/x )
171             {
172 37         212 my %msg = ( FILE => $FILENAME, LINE => $first->line, FLAGS => $flags, );
173 37 50       104 if ( _parseMsg( \%msg, $flags, $second ) ) {
174 37         54 push @{$RESULT}, \%msg;
  37         110  
175             }
176             else {
177 0         0 warn "Invalid parameters for translation command at '$FILENAME', line " . $first->line;
178             }
179             }
180             elsif ( $second->[0]->arity =~ /^(?: variable | methodcall | field )$/x ) {
181 6         19 next; # skip __($foo), __($foo.bar): nothing to do
182             }
183             else {
184 0         0 warn "Invalid parameters for translation command at '$FILENAME', line " . $first->line;
185             }
186             }
187             }
188             }
189              
190 860 50       1700 unless ( $self->debug ) {
191 860         2416 $self->_walker( $sym->first );
192 860         2390 $self->_walker( $sym->second );
193 860         1793 $self->_walker( $sym->third );
194             }
195             else {
196 0   0     0 warn $sp . "id: " . ( $sym->id // "undef()" ) . "\n";
197 0   0     0 warn $sp . "line: " . ( $sym->line // "undef()" ) . "\n";
198 0   0     0 warn $sp . "ldp: " . ( $sym->lbp // "undef()" ) . "\n";
199 0   0     0 warn $sp . "udp: " . ( $sym->ubp // "undef()" ) . "\n";
200 0   0     0 warn $sp . "type: " . ( $sym->type // "undef()" ) . "\n";
201 0   0     0 warn $sp . "arity: " . ( $sym->arity // "undef()" ) . "\n";
202 0   0     0 warn $sp . "assignment: " . ( $sym->assignment // "undef()" ) . "\n";
203 0   0     0 warn $sp . "value: " . ( $sym->value // "undef()" ) . "\n";
204              
205 0   0     0 warn $sp . "= first: " . ( $sym->first // "undef()" ) . "\n";
206 0         0 $sp .= ' ';
207 0         0 $self->_walker( $sym->first );
208 0         0 $sp =~ s/^..//;
209              
210 0   0     0 warn $sp . "= second: " . ( $sym->second // "undef()" ) . "\n";
211 0         0 $sp .= ' ';
212 0         0 $self->_walker( $sym->second );
213 0         0 $sp =~ s/^..//;
214              
215 0   0     0 warn $sp . "= third: " . ( $sym->third // "undef()" ) . "\n";
216 0         0 $sp .= ' ';
217 0         0 $self->_walker( $sym->third );
218 0         0 $sp =~ s/^..//;
219              
220 0         0 warn $sp . "----------\n";
221             }
222             } ## end for my $sym ( @{$ast} )
223             } ## end sub _walker
224              
225              
226             sub _parseMsg {
227 51     51   120 my ( $msg_r, $flags, $params ) = @_;
228              
229 51         87 my @p = @{$params};
  51         124  
230 51         99 eval {
231 51 100       168 if ( index( $flags, 'p' ) >= 0 ) {
232 10 50 33     66 if ( defined $p[0] and $p[0]->arity eq 'literal' ) {
233 10         36 $msg_r->{'MSGCTXT'} = $p[0]->value;
234 10         21 shift @p;
235             }
236             else {
237 0         0 die;
238             }
239             }
240              
241 51 100       153 if ( index( $flags, 'n' ) >= 0 ) {
242 8 50 33     105 if ( defined $p[0]
      33        
      33        
      33        
243             and $p[0]->arity eq 'literal'
244             and defined $p[1]
245             and $p[1]->arity eq 'literal'
246             and defined $p[2] )
247             {
248 8         27 $msg_r->{'MSGID'} = $p[0]->value;
249 8         30 $msg_r->{'MSGID_PLURAL'} = $p[1]->value;
250             }
251             else {
252 0         0 die;
253             }
254             }
255             else {
256 43 50 33     213 if ( defined $p[0] and $p[0]->arity eq 'literal' ) {
257 43         167 $msg_r->{'MSGID'} = $p[0]->value;
258             }
259             else {
260 0         0 die;
261             }
262             }
263             };
264              
265 51 50       127 return 0 if $@;
266 51         164 return 1;
267             } ## end sub _parseMsg
268              
269             __PACKAGE__->meta->make_immutable;
270              
271             1;
272              
273             __END__