File Coverage

blib/lib/Template/Plugin/Gettext.pm
Criterion Covered Total %
statement 201 216 93.0
branch 41 84 48.8
condition 16 51 31.3
subroutine 48 51 94.1
pod 15 16 93.7
total 321 418 76.7


line stmt bran cond sub pod time code
1             #! /bin/false
2              
3             # Copyright (C) 2016-2018 Guido Flohr ,
4             # all rights reserved.
5              
6             # This program is free software; you can redistribute it and/or modify it
7             # under the terms of the GNU Library General Public License as published
8             # by the Free Software Foundation; either version 2, or (at your option)
9             # any later version.
10              
11             # This program is distributed in the hope that it will be useful,
12             # but WITHOUT ANY WARRANTY; without even the implied warranty of
13             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14             # Library General Public License for more details.
15              
16             # You should have received a copy of the GNU Library General Public
17             # License along with this program; if not, write to the Free Software
18             # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
19             # USA.
20              
21             # ABSTRACT: Gettext Support For the Template Toolkit Version 2
22              
23             package Template::Plugin::Gettext;
24             $Template::Plugin::Gettext::VERSION = '0.8';
25 5     5   263130 use strict;
  5         15  
  5         205  
26              
27 5     5   2713 use Locale::TextDomain 1.30 qw(com.cantanea.Template-Plugin-Gettext);
  5         89580  
  5         37  
28 5     5   134133 use Locale::Messages;
  5         11  
  5         191  
29 5     5   2798 use Locale::Util qw(web_set_locale);
  5         20062  
  5         304  
30 5     5   40 use Encode;
  5         10  
  5         441  
31              
32 5     5   35 use Cwd qw(abs_path);
  5         10  
  5         208  
33              
34 5     5   32 use base qw(Template::Plugin);
  5         11  
  5         2554  
35              
36             my %bound_dirs;
37             my %textdomains;
38              
39             our @DEFAULT_DIRS;
40             our @LOCALE_DIRS;
41              
42             sub __find_domain($);
43             sub __expand($%);
44             sub __fixup;
45              
46             BEGIN {
47 5     5   3947 foreach my $dir (qw('/usr/share/locale /usr/local/share/locale')) {
48 10 50       15522 if (-d $dir) {
49 0         0 push @DEFAULT_DIRS, $dir;
50 0         0 last;
51             }
52             }
53             }
54              
55             sub new {
56 57     57 1 189534 my ($class, $ctx, $textdomain, $language, $charset, @search_dirs) = @_;
57              
58 57         141 my $self = bless {}, $class;
59              
60 57 50 33     212 $textdomain = 'textdomain' unless defined $textdomain && length $textdomain;
61 57 50 33     196 $charset = 'utf-8' unless defined $charset && length $charset;
62              
63 57         232 my $template = $ctx->stash->get('component')->name;
64 57 50 33     1526 if ('input text' eq $template || 'input file handle' eq $template) {
65 57         144 my $maybe_template = $ctx->stash->get('gettext_filename');
66 57 50 33     1010 $template = $maybe_template
67             if defined $maybe_template && length $maybe_template;
68             }
69 57         152 $textdomains{$textdomain}->{$template} = 1;
70              
71 57 100       174 unless (exists $bound_dirs{$textdomain}) {
72 56 50       135 unless (@search_dirs) {
73 56         570 @search_dirs = map $_ . '/LocaleData', @INC;
74 56         137 push @search_dirs, @DEFAULT_DIRS;
75             }
76 56         97 unshift @search_dirs, @LOCALE_DIRS;
77 56         194 $bound_dirs{$textdomain} = [@search_dirs];
78             }
79              
80 57         149 $self->{__textdomain} = $textdomain;
81 57 50       133 $self->{__locale} = web_set_locale $language, $charset if defined $language;
82              
83             $ctx->define_filter(gettext => sub {
84 3     3   203 my ($context) = @_;
85              
86             return sub {
87 3         89 return __gettext($textdomain, shift);
88 3         28 };
89 57         361 }, 1);
90             $ctx->define_filter(ngettext => sub {
91 4     4   189 my ($context, @args) = @_;
92 4 50       16 my $pairs = ref $args[-1] eq 'HASH' ? pop(@args) : {};
93              
94 4         12 push @args, %$pairs;
95             return sub {
96 4         78 return __ngettext($textdomain, shift, @args);
97 4         19 };
98 57         1611 }, 1);
99             $ctx->define_filter(pgettext => sub {
100 2     2   93 my ($context, @args) = @_;
101 2 50       8 my $pairs = ref $args[-1] eq 'HASH' ? pop(@args) : {};
102              
103 2         6 push @args, %$pairs;
104             return sub {
105 2         39 return __pgettext($textdomain, shift, @args);
106 2         11 };
107 57         1271 }, 1);
108             $ctx->define_filter(gettextp => sub {
109 2     2   94 my ($context, @args) = @_;
110 2 50       9 my $pairs = ref $args[-1] eq 'HASH' ? pop(@args) : {};
111              
112 2         6 push @args, %$pairs;
113             return sub {
114 2         43 return __gettextp($textdomain, shift, @args);
115 2         11 };
116 57         1213 }, 1);
117             $ctx->define_filter(npgettext => sub {
118 4     4   187 my ($context, @args) = @_;
119 4 50       15 my $pairs = ref $args[-1] eq 'HASH' ? pop(@args) : {};
120              
121 4         11 push @args, %$pairs;
122             return sub {
123 4         78 return __npgettext($textdomain, shift, @args);
124 4         20 };
125 57         1207 }, 1);
126             $ctx->define_filter(ngettextp => sub {
127 4     4   191 my ($context, @args) = @_;
128 4 50       13 my $pairs = ref $args[-1] eq 'HASH' ? pop(@args) : {};
129              
130 4         11 push @args, %$pairs;
131             return sub {
132 4         87 return __ngettextp($textdomain, shift, @args);
133 4         20 };
134 57         1294 }, 1);
135             $ctx->define_filter(xgettext => sub {
136 3     3   164 my ($context, @args) = @_;
137 3 50       14 my $pairs = ref $args[-1] eq 'HASH' ? pop(@args) : {};
138              
139 3         12 push @args, %$pairs;
140             return sub {
141 3         70 return __xgettext($textdomain, shift, @args);
142 3         15 };
143 57         1192 }, 1);
144             $ctx->define_filter(nxgettext => sub {
145 4     4   199 my ($context, @args) = @_;
146 4 50       15 my $pairs = ref $args[-1] eq 'HASH' ? pop(@args) : {};
147              
148 4         14 push @args, %$pairs;
149             return sub {
150 4         86 return __nxgettext($textdomain, shift, @args);
151 4         20 };
152 57         1171 }, 1);
153             $ctx->define_filter(pxgettext => sub {
154 2     2   95 my ($context, @args) = @_;
155 2 50       9 my $pairs = ref $args[-1] eq 'HASH' ? pop(@args) : {};
156              
157 2         8 push @args, %$pairs;
158             return sub {
159 2         44 return __pxgettext($textdomain, shift, @args);
160 2         10 };
161 57         1168 }, 1);
162             $ctx->define_filter(xgettextp => sub {
163 2     2   95 my ($context, @args) = @_;
164 2 50       10 my $pairs = ref $args[-1] eq 'HASH' ? pop(@args) : {};
165              
166 2         7 push @args, %$pairs;
167             return sub {
168 2         43 return __xgettextp($textdomain, shift, @args);
169 2         11 };
170 57         1145 }, 1);
171             $ctx->define_filter(npxgettext => sub {
172 4     4   189 my ($context, @args) = @_;
173 4 50       17 my $pairs = ref $args[-1] eq 'HASH' ? pop(@args) : {};
174              
175 4         15 push @args, %$pairs;
176             return sub {
177 4         82 return __npxgettext($textdomain, shift, @args);
178 4         19 };
179 57         1176 }, 1);
180             $ctx->define_filter(nxgettextp => sub {
181 4     4   189 my ($context, @args) = @_;
182 4 50       16 my $pairs = ref $args[-1] eq 'HASH' ? pop(@args) : {};
183              
184 4         13 push @args, %$pairs;
185             return sub {
186 4         86 return __nxgettextp($textdomain, shift, @args);
187 4         43 };
188 57         1182 }, 1);
189              
190 57         1126 return $self;
191             }
192              
193             sub __fixup {
194 56     56   2658 my $trans = $_[-1];
195              
196 56         167 Encode::_utf8_on($trans);
197              
198 56         317 return $trans;
199             }
200              
201             sub __gettext {
202 4     4   11 my ($textdomain, $msgid) = @_;
203              
204             __find_domain $textdomain
205 4 50 33     41 if defined $textdomain && exists $bound_dirs{$textdomain};
206              
207 4         18 return __fixup $msgid, Locale::Messages::dgettext($textdomain => $msgid);
208             }
209              
210             sub gettext {
211 1     1 1 39 my ($self, $msgid) = @_;
212              
213 1         3 return __gettext $self->{__textdomain}, $msgid;
214             }
215              
216             sub __ngettext {
217 6     6   15 my ($textdomain, $msgid, $msgid_plural, $count) = @_;
218              
219             __find_domain $textdomain
220 6 50 33     43 if defined $textdomain && exists $bound_dirs{$textdomain};
221              
222 6         27 return __fixup $msgid, $msgid_plural, $count,
223             Locale::Messages::dngettext($textdomain => $msgid,
224             $msgid_plural, $count);
225             }
226              
227             sub ngettext {
228 2     2 1 57 my ($self, $msgid, $msgid_plural, $count) = @_;
229              
230 2         7 return __ngettext $self->{__textdomain}, $msgid, $msgid_plural, $count;
231             }
232              
233             sub __pgettext {
234 3     3   9 my ($textdomain, $context, $msgid) = @_;
235              
236             __find_domain $textdomain
237 3 50 33     27 if defined $textdomain && exists $bound_dirs{$textdomain};
238              
239 3         16 return __fixup $msgid,
240             Locale::Messages::dpgettext($textdomain => $context, $msgid);
241             }
242              
243             sub pgettext {
244 1     1 1 29 my ($self, $context, $msgid) = @_;
245              
246 1         6 return __pgettext $self->{__textdomain}, $context, $msgid;
247             }
248              
249             sub __gettextp {
250 3     3   12 my ($textdomain, $msgid, $context) = @_;
251              
252             __find_domain $textdomain
253 3 50 33     30 if defined $textdomain && exists $bound_dirs{$textdomain};
254              
255 3         12 return __fixup $msgid,
256             Locale::Messages::dpgettext($textdomain => $context, $msgid);
257             }
258              
259             sub gettextp {
260 1     1 1 34 my ($self, $msgid, $context) = @_;
261              
262 1         7 return __gettextp $self->{__textdomain}, $msgid, $context;
263             }
264              
265             sub __npgettext {
266 6     6   16 my ($textdomain, $context, $msgid, $msgid_plural, $count) = @_;
267              
268             __find_domain $textdomain
269 6 50 33     53 if defined $textdomain && exists $bound_dirs{$textdomain};
270              
271 6         27 return __fixup $msgid, $msgid_plural, $count,
272             Locale::Messages::dnpgettext($textdomain, $context, $msgid,
273             $msgid_plural, $count);
274             }
275              
276             sub npgettext {
277 2     2 1 56 my ($self, $context, $msgid, $msgid_plural, $count) = @_;
278              
279 2         8 return __npgettext $self->{__textdomain}, $context, $msgid, $msgid_plural,
280             $count;
281             }
282              
283             sub __ngettextp {
284 6     6   19 my ($textdomain, $msgid, $msgid_plural, $count, $context) = @_;
285              
286             __find_domain $textdomain
287 6 50 33     47 if defined $textdomain && exists $bound_dirs{$textdomain};
288              
289 6         27 return __fixup $msgid, $msgid_plural, $count,
290             Locale::Messages::dnpgettext($textdomain => $context, $msgid,
291             $msgid_plural, $count);
292             }
293              
294             sub ngettextp {
295 2     2 0 57 my ($self, $msgid, $msgid_plural, $count, $context) = @_;
296              
297 2         12 return __ngettextp $self->{__textdomain}, $msgid, $msgid_plural, $count,
298             $context;
299             }
300              
301             sub __xgettext {
302 4     4   17 my ($textdomain, $msgid, %vars) = @_;
303              
304             __find_domain $textdomain
305 4 50 33     46 if defined $textdomain && exists $bound_dirs{$textdomain};
306              
307 4         22 return __expand((__fixup $msgid,
308             Locale::Messages::dgettext($textdomain => $msgid)), %vars);
309             }
310              
311             sub xgettext {
312 1     1 1 32 my ($self, $msgid, @args) = @_;
313            
314 1 50       5 my $pairs = ref $args[-1] eq 'HASH' ? pop(@args) : {};
315 1         5 push @args, %$pairs;
316              
317 1         6 return __xgettext $self->{__textdomain}, $msgid, @args;
318             }
319              
320             sub __nxgettext {
321 6     6   23 my ($textdomain, $msgid, $msgid_plural, $count, %vars) = @_;
322              
323             __find_domain $textdomain
324 6 50 33     61 if defined $textdomain && exists $bound_dirs{$textdomain};
325              
326 6         30 return __expand((__fixup $msgid, $msgid_plural, $count,
327             Locale::Messages::dngettext($textdomain => $msgid,
328             $msgid_plural,
329             $count)),
330             %vars);
331             }
332              
333             sub nxgettext {
334 2     2 1 60 my ($self, $msgid, $msgid_plural, $count, @args) = @_;
335              
336 2 50       10 my $pairs = ref $args[-1] eq 'HASH' ? pop(@args) : {};
337 2         9 push @args, %$pairs;
338              
339 2         7 return __nxgettext $self->{__textdomain}, $msgid, $msgid_plural, $count,
340             @args;
341             }
342              
343             sub __pxgettext {
344 3     3   13 my ($textdomain, $context, $msgid, %vars) = @_;
345              
346             __find_domain $textdomain
347 3 50 33     30 if defined $textdomain && exists $bound_dirs{$textdomain};
348              
349 3         17 return __expand((__fixup $msgid,
350             Locale::Messages::dpgettext($textdomain => $context,
351             $msgid)),
352             %vars);
353             }
354              
355             sub pxgettext {
356 1     1 1 30 my ($self, $context, @args) = @_;
357            
358 1 50       6 my $pairs = ref $args[-1] eq 'HASH' ? pop(@args) : {};
359 1         4 push @args, %$pairs;
360              
361 1         4 return __pxgettext $self->{__textdomain}, $context, @args;
362             }
363              
364             sub __xgettextp {
365 3     3   12 my ($textdomain, $msgid, $context, %vars) = @_;
366              
367             __find_domain $textdomain
368 3 50 33     33 if defined $textdomain && exists $bound_dirs{$textdomain};
369              
370 3         14 return __expand((__fixup $msgid,
371             Locale::Messages::dpgettext($textdomain => $context,
372             $msgid)),
373             %vars);
374             }
375              
376             sub xgettextp {
377 1     1 1 31 my ($self, $msgid, @args) = @_;
378            
379 1 50       7 my $pairs = ref $args[-1] eq 'HASH' ? pop(@args) : {};
380 1         6 push @args, %$pairs;
381              
382 1         5 return __xgettextp $self->{__textdomain}, $msgid, @args;
383             }
384              
385             sub __npxgettext {
386 6     6   55 my ($textdomain, $context, $msgid, $msgid_plural, $count, %vars) = @_;
387              
388             __find_domain $textdomain
389 6 50 33     49 if defined $textdomain && exists $bound_dirs{$textdomain};
390              
391 6         28 return __expand((__fixup $msgid, $msgid_plural, $count,
392             Locale::Messages::dnpgettext($textdomain => $context,
393             $msgid, $msgid_plural,
394             $count)),
395             %vars);
396             }
397              
398             sub npxgettext {
399 2     2 1 60 my ($self, $context, @args) = @_;
400            
401 2 50       9 my $pairs = ref $args[-1] eq 'HASH' ? pop(@args) : {};
402 2         8 push @args, %$pairs;
403              
404 2         8 return __npxgettext $self->{__textdomain}, $context, @args;
405             }
406              
407             sub __nxgettextp {
408 6     6   23 my ($textdomain, $msgid, $msgid_plural, $count, $context, %vars) = @_;
409              
410             __find_domain $textdomain
411 6 50 33     46 if defined $textdomain && exists $bound_dirs{$textdomain};
412              
413 6         22 return __expand((__fixup $msgid, $msgid_plural, $count,
414             Locale::Messages::dnpgettext($textdomain => $context,
415             $msgid, $msgid_plural,
416             $count)),
417             %vars);
418             }
419              
420             sub nxgettextp {
421 2     2 1 59 my ($self, $msgid, @args) = @_;
422            
423 2 50       11 my $pairs = ref $args[-1] eq 'HASH' ? pop(@args) : {};
424 2         7 push @args, %$pairs;
425              
426 2         8 return __nxgettextp $self->{__textdomain}, $msgid, @args;
427             }
428              
429             sub debug_locale {
430 0     0 1 0 shift->{__locale};
431             }
432              
433             sub __expand($%) {
434 28     28   84 my ($str, %vars) = @_;
435              
436 28         75 my $re = join '|', map { quotemeta } keys %vars;
  28         104  
437 28         364 $str =~ s/\{($re)\}/exists $vars{$1} ?
438 19 50       134 (defined $vars{$1} ? $vars{$1} : '') : "{$1}"/ge;
    50          
439              
440 28         264 return $str;
441             }
442              
443             sub __find_domain($) {
444 56     56   116 my ($domain) = @_;
445              
446 56         104 my $try_dirs = $bound_dirs{$domain};
447              
448 56 50       120 if (defined $try_dirs) {
449 56         86 my $found_dir = '';
450              
451 56         111 TRYDIR: foreach my $dir (map {abs_path $_} grep { -d $_ } @$try_dirs) {
  0         0  
  672         5597  
452             # Is there a message catalog?
453              
454 0         0 local *DIR;
455 0 0       0 if (opendir DIR, $dir) {
456 0         0 my @files = map { "$dir/$_/LC_MESSAGES/$domain.mo" }
457 0         0 grep { ! /^\.\.?$/ } readdir DIR;
  0         0  
458 0         0 foreach my $file (@files) {
459 0 0 0     0 if (-f $file || -l $file) {
460 0         0 $found_dir = $dir;
461 0         0 last TRYDIR;
462             }
463             }
464             }
465             }
466              
467             # If $found_dir is undef, the default search directories are
468             # used.
469 56         221 Locale::Messages::bindtextdomain($domain => $found_dir);
470             }
471              
472 56         1016 delete $bound_dirs{$domain};
473              
474 56         172 return 1;
475             }
476              
477             sub textdomains {
478 0     0 1   return %textdomains;
479             }
480              
481             sub resetTextdomains {
482 0     0 1   undef %textdomains;
483             }
484              
485             1;