File Coverage

blib/lib/Locale/TextDomain/OO/Extract/Process/Plugin/MO.pm
Criterion Covered Total %
statement 33 83 39.7
branch 0 20 0.0
condition 0 6 0.0
subroutine 11 15 73.3
pod 3 3 100.0
total 47 127 37.0


line stmt bran cond sub pod time code
1             package Locale::TextDomain::OO::Extract::Process::Plugin::MO; ## no critic (TidyCode)
2            
3 1     1   14062 use strict;
  1         3  
  1         34  
4 1     1   6 use warnings;
  1         2  
  1         36  
5 1     1   5 use Carp qw(confess);
  1         2  
  1         61  
6 1     1   550 use Encode qw(find_encoding);
  1         9500  
  1         71  
7 1     1   464 use Locale::MO::File;
  1         32250  
  1         33  
8 1     1   507 use Locale::TextDomain::OO::Util::ExtractHeader;
  1         1449  
  1         32  
9 1     1   8 use Locale::TextDomain::OO::Util::JoinSplitLexiconKeys;
  1         3  
  1         31  
10 1     1   6 use Moo;
  1         3  
  1         6  
11 1     1   356 use MooX::StrictConstructor;
  1         3  
  1         7  
12 1     1   893 use MooX::Types::MooseLike::Base qw(HashRef Str);
  1         3  
  1         56  
13 1     1   7 use namespace::autoclean;
  1         2  
  1         5  
14            
15             our $VERSION = '2.007';
16            
17             has category => (
18             is => 'rw',
19             isa => Str,
20             lazy => 1,
21             default => q{},
22             );
23            
24             has domain => (
25             is => 'rw',
26             isa => Str,
27             lazy => 1,
28             default => q{},
29             );
30            
31             has language => (
32             is => 'rw',
33             isa => Str,
34             lazy => 1,
35             default => 'i-default',
36             );
37            
38             has project => (
39             is => 'rw',
40             isa => sub {
41             my $project = shift;
42             defined $project
43             or return;
44             return Str->($project);
45             },
46             );
47            
48             has lexicon_ref => (
49             is => 'rw',
50             isa => HashRef,
51             lazy => 1,
52             default => sub { {} },
53             );
54            
55             sub clear {
56 0     0 1   my $self = shift;
57            
58 0           $self->category( q{} );
59 0           $self->domain( q{} );
60 0           $self->language('i-default');
61 0           $self->project(undef);
62 0           $self->lexicon_ref( {} );
63            
64 0           return;
65             }
66            
67             sub slurp {
68 0     0 1   my ( $self, $filename ) = @_;
69            
70 0 0         defined $filename
71             or confess 'Undef is not a name of a mo file';
72 0           my $mo = Locale::MO::File->new( filename => $filename );
73 0           $mo->read_file;
74 0           my $messages_ref = $mo->get_messages;
75            
76             my $header = Locale::TextDomain::OO::Util::ExtractHeader
77             ->instance
78             ->extract_header_msgstr(
79             $messages_ref->[0]->{msgstr}
80 0   0       || confess "No header found in file $filename",
81             );
82 0           my $encode_obj = find_encoding( $header->{charset} );
83 0           my $nplurals = $header->{nplurals};
84 0           my $plural = $header->{plural};
85            
86             my $decode_code = sub {
87 0     0     my $text = shift;
88             #
89 0 0         defined $text
90             or return;
91 0 0         length $text
92             or return q{};
93             #
94 0           return $encode_obj->decode($text);
95 0           };
96            
97 0           my $key_util = Locale::TextDomain::OO::Util::JoinSplitLexiconKeys->instance;
98 0           my $index = 0;
99 0           for my $message_ref ( @{$messages_ref} ) {
  0            
100             $self
101             ->lexicon_ref
102             ->{
103             $key_util->join_lexicon_key({
104             category => $self->category,
105             domain => $self->domain,
106             language => $self->language,
107             project => $self->project,
108             })
109             }
110             ->{
111             $key_util->join_message_key({
112             msgctxt => scalar $decode_code->( $message_ref->{msgctxt} ),
113             msgid => scalar $decode_code->( $message_ref->{msgid} ),
114             msgid_plural => scalar $decode_code->( $message_ref->{msgid_plural} ),
115             })
116             } = {
117             (
118             $index++
119             ? ()
120             : (
121             nplurals => $nplurals,
122             plural => $plural,
123             )
124             ),
125             (
126             exists $message_ref->{msgstr_plural}
127             ? (
128             msgstr_plural => [
129             map {
130 0           scalar $decode_code->( $message_ref->{msgstr_plural}->[$_] );
131             }
132             0 .. ( $nplurals - 1 )
133             ]
134             )
135 0 0         : ( msgstr => scalar $decode_code->( $message_ref->{msgstr} ) )
    0          
136             ),
137             };
138             }
139            
140 0           return;
141             }
142            
143             sub spew {
144 0     0 1   my ( $self, $filename ) = @_;
145            
146 0 0         defined $filename
147             or confess 'Undef is not a name of a mo file';
148            
149 0           my $key_util = Locale::TextDomain::OO::Util::JoinSplitLexiconKeys->instance;
150 0           my $lexicon_key = $key_util
151             ->instance
152             ->join_lexicon_key({
153             category => $self->category,
154             domain => $self->domain,
155             language => $self->language,
156             project => $self->project,
157             });
158 0 0         my $messages_ref = $self->lexicon_ref->{$lexicon_key}
    0          
159             or confess sprintf
160             'No lexicon found for category "%s", domain "%s", language "%s" and project "%s"',
161             $self->category,
162             $self->domain,
163             $self->language
164             ( defined $self->project ? $self->project : 'undef' );
165            
166             my $header = Locale::TextDomain::OO::Util::ExtractHeader
167             ->instance
168             ->extract_header_msgstr(
169             $messages_ref->{ q{} }->{msgstr}
170 0 0 0       || confess 'No header set.',
    0          
171             )
172             or confess sprintf
173             'No header found in lexicon of category "%s", domain "%s", language "%s" and project "%s"',
174             $self->category,
175             $self->domain,
176             $self->language,
177             ( defined $self->project ? $self->project : 'undef' );
178 0           my $charset = $header->{charset};
179 0           my $encode_obj = find_encoding($charset);
180 0           my $nplurals = $header->{nplurals};
181            
182             my $message_ref = $self
183             ->lexicon_ref
184             ->{
185 0           $key_util->join_lexicon_key({
186             category => $self->category,
187             domain => $self->domain,
188             language => $self->language,
189             project => $self->project,
190             })
191             };
192            
193             my %mo_key_of
194 0           = map { $_ => undef }
  0            
195             qw( msgctxt msgid msgid_plural msgstr msgstr_plural );
196             my $mo = Locale::MO::File->new(
197             filename => $filename,
198             encoding => $charset,
199             messages => [
200             map { ## no critic (ComplexMappings)
201 0           my $return_ref = $key_util->join_message( $_, $message_ref->{$_} );
202 0           delete @{$return_ref}{
203             grep {
204 0           ! exists $mo_key_of{$_};
205 0           } keys %{$return_ref}
  0            
206             };
207 0           $return_ref;
208             }
209             sort
210 0           keys %{$message_ref}
  0            
211             ],
212             );
213 0           $mo->write_file;
214            
215 0           return;
216             }
217            
218             __PACKAGE__->meta->make_immutable;
219            
220             1;
221            
222             __END__