File Coverage

blib/lib/Data/Localize/Gettext/Parser.pm
Criterion Covered Total %
statement 43 43 100.0
branch 21 24 87.5
condition 6 6 100.0
subroutine 4 4 100.0
pod 1 1 100.0
total 75 78 96.1


line stmt bran cond sub pod time code
1             package Data::Localize::Gettext::Parser;
2 2     2   90177 use Moo;
  2         11432  
  2         8  
3              
4             has encoding => (
5             is => 'ro',
6             required => 1,
7             );
8              
9             has use_fuzzy => (
10             is => 'ro',
11             required => 1,
12             );
13              
14             has keep_empty => (
15             is => 'ro',
16             required => 1,
17             );
18              
19             sub parse_file {
20 11     11 1 10894 my ($self, $file) = @_;
21              
22 11         148 my $enc = ':encoding(' . $self->encoding . ')';
23 2 50   2   16 open(my $fh, "<$enc", $file) or die "Could not open $file: $!";
  2         3  
  2         14  
  11         466  
24              
25 11         14187 my @block = ();
26 11         41 my %lexicons;
27 11         231 while ( defined( my $line = <$fh> ) ) {
28 74         499 $line =~ s/[\015\012]*\z//; # fix CRLF issues
29              
30 74 100       193 if ( $line =~ /^\s*$/ ) {
31 18 50       164 $self->_process_block(\@block, \%lexicons) if @block;
32 18         35 @block = ();
33 18         86 next;
34             }
35              
36 56         272 push @block, $line;
37             }
38              
39 11 100       50 $self->_process_block(\@block, \%lexicons) if @block;
40              
41 11         248 return \%lexicons;
42             }
43              
44             sub _process_block {
45 25     25   47 my ($self, $block, $lexicons) = @_;
46              
47 25         33 my $msgid = q{};
48 25         28 my $msgstr = q{};
49 25         29 my $value;
50 25         34 my $is_fuzzy = 0;
51              
52             # Note that we are ignoring the various types of comments allowed in a .po
53             # file - see
54             # http://www.gnu.org/software/gettext/manual/gettext.html#PO-Files for
55             # more details.
56             #
57             # We do not handle the msgstr[0]/msgstr[1] type of string.
58             #
59             # Finally, we don't handle msgctxt at all.
60 25         30 for my $line (@{$block} ) {
  25         53  
61 56 100       226 if ( $line =~ /^msgid\s+"(.*)"\s*$/ ) {
    100          
    100          
    50          
62 25         36 $value = \$msgid;
63              
64 25         33 ${$value} .= $1;
  25         66  
65             }
66             elsif ( $line =~ /^msgstr\s+"(.*)"\s*$/ ) {
67 25         38 $value = \$msgstr;
68              
69 25         28 ${$value} .= $1;
  25         59  
70             }
71             elsif ( $line =~ /^"(.*)"\s*$/ ) {
72 4         6 ${$value} .= $1;
  4         7  
73             }
74             elsif ( $line =~ /#,\s+.*fuzzy.*$/ ) {
75 2         5 $is_fuzzy = 1;
76             }
77             }
78              
79 25 100 100     116 return unless length $msgstr || $self->keep_empty();
80              
81 24 100 100     63 return if $is_fuzzy && ! $self->use_fuzzy();
82              
83 23 100       71 s/\\(n|\\|\")/ $1 eq 'n' ? "\n" : $1 eq '\\' ? "\\" : '"' /ge for $msgid, $msgstr;
  10 100       41  
84              
85 23         71 $lexicons->{$msgid} = $msgstr;
86              
87 23         42 return;
88             }
89              
90             1;
91              
92             __END__