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 6     6   44 use warnings;
  6         45  
  6         217  
6 6     6   32 use strict;
  6         15  
  6         193  
7              
8             package Log::Report::Template::Textdomain;
9 6     6   32 use vars '$VERSION';
  6         11  
  6         330  
10             $VERSION = '0.11';
11              
12 6     6   35 use base 'Log::Report::Domain';
  6         14  
  6         479  
13              
14 6     6   39 use Log::Report 'log-report-template';
  6         14  
  6         40  
15              
16 6     6   1434 use Log::Report::Message ();
  6         16  
  6         3227  
17              
18              
19             sub init($)
20 6     6 0 73 { my ($self, $args) = @_;
21 6         46 $self->SUPER::init($args);
22              
23 6 100       150 if(my $only = $args->{only_in_directory})
24 2 50       14 { my @only = ref $only eq 'ARRAY' ? @$only : $only;
25 2         12 my $dirs = join '|', map "\Q$_\E", @only;
26 2         39 $self->{LRTT_only_in} = qr!^(?:$dirs)(?:$|/)!;
27             }
28              
29 6   100     41 $self->{LRTT_function} = $args->{translation_function} || 'loc';
30 6         18 my $lexicon = $self->{LRTT_lexicon} = $args->{lexicon};
31 6         21 $self;
32             }
33              
34             #----------------
35              
36 10     10 1 1077 sub function() { shift->{LRTT_function} }
37              
38              
39 2     2 1 16 sub lexicon() { shift->{LRTT_lexicon} }
40              
41              
42             sub expectedIn($)
43 3     3 1 11 { my ($self, $fn) = @_;
44 3 100       17 my $only = $self->{LRTT_only_in} or return 1;
45 2         20 $fn =~ $only;
46             }
47              
48             #----------------
49              
50             sub translationFunction($)
51 5     5 1 49 { my ($self, $service) = @_;
52 5         13 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   48659 $_[1]->{_stash} = $service->{CONTEXT}{STASH};
57 4         46 Log::Report::Message->fromTemplateToolkit($self, @_)->toString($lang);
58 5         44 };
59             }
60              
61             sub translationFilter()
62 5     5 0 11 { my $self = shift;
63 5         19 my $domain = $self->name;
64 5         24 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 5         37 };
  0         0  
80             }
81              
82             sub _reportMissingKey($$)
83 2     2   761 { 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         11 my $stash = $args->{_stash};
89 2 50       11 if($stash)
90 2         23 { my $value = $stash->get($key);
91 2 100 66     40 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         13 , use => $stash->{template}{name};
98              
99 1         472 undef;
100             }
101              
102             1;