File Coverage

lib/Log/Report/Template/Textdomain.pm
Criterion Covered Total %
statement 48 53 90.5
branch 8 12 66.6
condition 4 8 50.0
subroutine 14 15 93.3
pod 4 6 66.6
total 78 94 82.9


line stmt bran cond sub pod time code
1             # Copyrights 2017 by [Mark Overmeer].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.02.
5 7     7   47 use warnings;
  7         17  
  7         244  
6 7     7   39 use strict;
  7         15  
  7         227  
7              
8             package Log::Report::Template::Textdomain;
9 7     7   35 use vars '$VERSION';
  7         15  
  7         375  
10             $VERSION = '0.12';
11              
12 7     7   41 use base 'Log::Report::Domain';
  7         21  
  7         529  
13              
14 7     7   40 use Log::Report 'log-report-template';
  7         14  
  7         37  
15              
16 7     7   1398 use Log::Report::Message ();
  7         12  
  7         3371  
17              
18              
19             sub init($)
20 7     7 0 79 { my ($self, $args) = @_;
21 7         44 $self->SUPER::init($args);
22              
23 7 100       169 if(my $only = $args->{only_in_directory})
24 2 50       19 { my @only = ref $only eq 'ARRAY' ? @$only : $only;
25 2         14 my $dirs = join '|', map "\Q$_\E", @only;
26 2         37 $self->{LRTT_only_in} = qr!^(?:$dirs)(?:$|/)!;
27             }
28              
29 7   100     48 $self->{LRTT_function} = $args->{translation_function} || 'loc';
30 7         16 my $lexicon = $self->{LRTT_lexicon} = $args->{lexicon};
31 7         21 $self;
32             }
33              
34             #----------------
35              
36 14     14 1 1095 sub function() { shift->{LRTT_function} }
37              
38              
39 2     2 1 22 sub lexicon() { shift->{LRTT_lexicon} }
40              
41              
42             sub expectedIn($)
43 3     3 1 9 { my ($self, $fn) = @_;
44 3 100       17 my $only = $self->{LRTT_only_in} or return 1;
45 2         24 $fn =~ $only;
46             }
47              
48             #----------------
49              
50             sub translationFunction($)
51 6     6 1 48 { my ($self, $service) = @_;
52 6         12 my $lang = 'NL';
53              
54             # Prepare as much and fast as possible, because it gets called often!
55             sub { # called with ($msgid, \%params)
56 4     4   32742 $_[1]->{_stash} = $service->{CONTEXT}{STASH};
57 4         30 Log::Report::Message->fromTemplateToolkit($self, @_)->toString($lang);
58 6         38 };
59             }
60              
61             sub translationFilter()
62 6     6 0 14 { my $self = shift;
63 6         19 my $domain = $self->name;
64 6         23 my $lang = 'NL';
65              
66             # Prepare as much and fast as possible, because it gets called often!
67             # A TT filter can be either static or dynamic. Dynamic filters need to
68             # implement a "a factory for static filters": a sub which produces a
69             # sub which does the real work.
70             sub {
71 0     0   0 my $context = shift;
72 0 0 0     0 my $pairs = pop if @_ && ref $_[-1] eq 'HASH';
73             sub { # called with $msgid (template container content) only, the
74             # parameters are caught when the factory produces this sub.
75 0         0 $pairs->{_stash} = $context->{STASH};
76 0         0 Log::Report::Message->fromTemplateToolkit($self, $_[0], $pairs)
77             ->toString($lang);
78             }
79 6         37 };
  0         0  
80             }
81              
82             sub _reportMissingKey($$)
83 2     2   383 { my ($self, $sp, $key, $args) = @_;
84              
85             # Try to grab the value from the stash. That's a major advantange
86             # of TT over plain Perl: we have access to the variable namespace.
87              
88 2         5 my $stash = $args->{_stash};
89 2 50       9 if($stash)
90 2         15 { my $value = $stash->get($key);
91 2 100 66     25 return $value if defined $value && length $value;
92             }
93              
94             warning
95             __x"Missing key '{key}' in format '{format}', in {use //template}"
96             , key => $key, format => $args->{_format}
97 1         7 , use => $stash->{template}{name};
98              
99 1         316 undef;
100             }
101              
102             1;