File Coverage

blib/lib/Log/Report/Lexicon/Table.pm
Criterion Covered Total %
statement 39 44 88.6
branch 9 14 64.2
condition n/a
subroutine 12 17 70.5
pod 9 10 90.0
total 69 85 81.1


line stmt bran cond sub pod time code
1             # Copyrights 2007-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   45 use warnings;
  6         12  
  6         221  
6 6     6   34 use strict;
  6         13  
  6         178  
7              
8             package Log::Report::Lexicon::Table;
9 6     6   43 use vars '$VERSION';
  6         12  
  6         336  
10             $VERSION = '1.09';
11              
12              
13 6     6   307 use Log::Report 'log-report-lexicon';
  6         91232  
  6         36  
14              
15 6     6   1632 use POSIX qw/strftime/;
  6         21  
  6         48  
16 6     6   486 use IO::File ();
  6         16  
  6         150  
17 6     6   32 use List::Util qw/sum/;
  6         15  
  6         3335  
18              
19              
20 2     2 1 495 sub new(@) { my $class = shift; (bless {}, $class)->init({@_}) }
  2         22  
21 0     0 0 0 sub init($) {shift}
22              
23             #-----------------------
24              
25             #-----------------------
26              
27 0     0 1 0 sub msgid($;$) {panic "not implemented"}
28 0     0 1 0 sub msgstr($;$$) {panic "not implemented"}
29              
30             #------------------
31              
32 0     0 1 0 sub add($) {panic "not implemented"}
33              
34              
35 0     0 1 0 sub translations(;$) {panic "not implemented"}
36              
37              
38             sub pluralIndex($)
39 23     23 1 47 { my ($self, $count) = @_;
40             my $algo = $self->{algo}
41 23 50       61 or error __x"there is no Plural-Forms field in the header, but needed";
42              
43 23         476 $algo->($count);
44             }
45              
46              
47             sub setupPluralAlgorithm()
48 18     18 1 29 { my $self = shift;
49 18 100       54 my $forms = $self->header('Plural-Forms') or return;
50              
51 7 50       61 my $alg = $forms =~ m/plural\=([n%!=><\s\d|&?:()]+)/ ? $1 : "n!=1";
52 7         59 $alg =~ s/\bn\b/(\$_[0])/g;
53 7         514 my $code = eval "sub(\$) {$alg}";
54 7 50       28 $@ and error __x"invalid plural-form algorithm '{alg}'", alg => $alg;
55 7         16 $self->{algo} = $code;
56              
57 7 50       53 $self->{nplurals} = $forms =~ m/\bnplurals\=(\d+)/ ? $1 : 2;
58 7         17 $self;
59             }
60              
61              
62 8     8 1 42 sub nrPlurals() {shift->{nplurals}}
63              
64              
65             sub header($@)
66 14     14 1 566 { my ($self, $field) = @_;
67 14 50       33 my $header = $self->msgid('') or return;
68 14 100       273 $header =~ m/^\Q$field\E\:\s*([^\n]*?)\;?\s*$/im ? $1 : undef;
69             }
70              
71             1;