File Coverage

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


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 5     5   49 use warnings;
  5         16  
  5         193  
6 5     5   35 use strict;
  5         15  
  5         183  
7              
8             package Log::Report::Lexicon::Table;
9 5     5   35 use vars '$VERSION';
  5         11  
  5         280  
10             $VERSION = '1.08';
11              
12              
13 5     5   456 use Log::Report 'log-report-lexicon';
  5         101063  
  5         47  
14              
15 5     5   1839 use POSIX qw/strftime/;
  5         21  
  5         50  
16 5     5   406 use IO::File ();
  5         15  
  5         153  
17 5     5   39 use List::Util qw/sum/;
  5         15  
  5         3250  
18              
19              
20 2     2 1 488 sub new(@) { my $class = shift; (bless {}, $class)->init({@_}) }
  2         19  
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 51 { my ($self, $count) = @_;
40 23 50       67 my $algo = $self->{algo} or panic;
41 23         498 $algo->($count);
42             }
43              
44              
45             sub setupPluralAlgorithm()
46 5     5 1 17 { my $self = shift;
47 5 50       37 my $forms = $self->header('Plural-Forms')
48             or error __x"there is no Plural-Forms field in the header";
49              
50 5 50       61 my $alg = $forms =~ m/plural\=([n%!=><\s\d|&?:()]+)/ ? $1 : "n!=1";
51 5         55 $alg =~ s/\bn\b/(\$_[0])/g;
52 5         547 my $code = eval "sub(\$) {$alg}";
53 5 50       27 $@ and error __x"invalid plural-form algorithm '{alg}'", alg => $alg;
54 5         18 $self->{algo} = $code;
55              
56 5 50       58 $self->{nplurals} = $forms =~ m/\bnplurals\=(\d+)/ ? $1 : 2;
57 5         21 $self;
58             }
59              
60              
61 8     8 1 49 sub nrPlurals() {shift->{nplurals}}
62              
63              
64             sub header($@)
65 2     2 1 1188 { my ($self, $field) = @_;
66 2 50       9 my $header = $self->msgid('') or return;
67 2 50       117 $header =~ m/^\Q$field\E\:\s*([^\n]*?)\;?\s*$/im ? $1 : undef;
68             }
69              
70             1;