File Coverage

blib/lib/Locale/File/PO/Header.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package Locale::File::PO::Header; ## no critic (TidyCode)
2              
3 4     4   253664 use Moose;
  0            
  0            
4             use MooseX::StrictConstructor;
5              
6             use namespace::autoclean;
7             use syntax qw(method);
8              
9             require Locale::File::PO::Header::Item;
10             require Locale::File::PO::Header::MailItem;
11             require Locale::File::PO::Header::ContentTypeItem;
12             require Locale::File::PO::Header::ExtendedItem;
13              
14             our $VERSION = '0.003';
15              
16             has _header => (
17             is => 'rw',
18             init_arg => undef,
19             lazy => 1,
20             default => \&_default_header,
21             );
22              
23             has _header_index => (
24             is => 'ro',
25             init_arg => undef,
26             lazy => 1,
27             default => method {
28             my %header_index;
29             my $index = 0;
30             for my $item ( @{ $self->_header } ) {
31             for my $key ( $item->header_keys ) {
32             $header_index{$key} = $index;
33             }
34             $index++;
35             }
36              
37             return \%header_index;
38             },
39             );
40              
41             method _default_header {
42             return [
43             Locale::File::PO::Header::Item->new(
44             name => 'Project-Id-Version',
45             ),
46             Locale::File::PO::Header::MailItem->new(
47             name => 'Report-Msgid-Bugs-To',
48             ),
49             Locale::File::PO::Header::Item->new(
50             name => 'POT-Creation-Date',
51             ),
52             Locale::File::PO::Header::Item->new(
53             name => 'PO-Revision-Date',
54             ),
55             Locale::File::PO::Header::MailItem->new(
56             name => 'Last-Translator',
57             ),
58             Locale::File::PO::Header::MailItem->new(
59             name => 'Language-Team',
60             ),
61             Locale::File::PO::Header::Item->new(
62             name => 'MIME-Version',
63             default => '1.0',
64             ),
65             Locale::File::PO::Header::ContentTypeItem->new(
66             name => 'Content-Type',
67             default => {
68             'Content-Type' => 'text/plain',
69             charset => 'ISO-8859-1',
70             },
71             ),
72             Locale::File::PO::Header::Item->new(
73             name => 'Content-Transfer-Encoding',
74             default => '8bit',
75             ),
76             Locale::File::PO::Header::Item->new(
77             name => 'Plural-Forms',
78             ),
79             Locale::File::PO::Header::ExtendedItem->new(
80             name => 'extended',
81             ),
82             ];
83             }
84              
85             # get only
86             method all_keys {
87             return map {
88             $_->header_keys;
89             } @{ $self->_header };
90             }
91              
92             # set only
93             method data ($data) {
94             ref $data eq 'HASH'
95             or confess 'Hash reference expected';
96             $self->_header( $self->_default_header );
97             for my $key ( keys %{$data} ) {
98             my $value = delete $data->{$key};
99             if ( defined $value && length $value ) {
100             my $index = $self->_header_index->{$key};
101             defined $index
102             or confess "Unknown key $key";
103             my $item = $self->_header->[$index]->data($key, $value);
104             }
105             }
106              
107             return;
108             }
109              
110             method item ($key, $value) {
111             defined $key
112             or confess 'Undefined key';
113             my $index = $self->_header_index->{$key};
114             defined $index
115             or confess "Unknown key $key";
116             my $item = $self->_header->[$index];
117             # set
118             if ( defined $value && length $value ) {
119             return $item->data($key, $value);
120             }
121              
122             # get
123             return $item->data($key);
124             }
125              
126             # get only
127             method items (@args) {
128             return map { $self->item($_) } @args;
129             }
130              
131             method msgstr (@args) {
132             # set
133             if (@args) {
134             my $msgstr = defined $args[0] ? $args[0] : q{};
135             for my $item ( @{ $self->_header } ) {
136             $item->extract_msgstr(\$msgstr);
137             }
138             return;
139             }
140              
141             # get
142             return join "\n", map { $_->lines } @{ $self->_header };
143             }
144              
145             __PACKAGE__->meta->make_immutable;
146              
147             # $Id:$
148              
149             1;
150              
151             __END__
152              
153             =head1 NAME
154              
155             Locale::File::PO::Header - Utils to build/extract the PO header
156              
157             $Id: Utils.pm 602 2011-11-13 13:49:23Z steffenw $
158              
159             $HeadURL: https://dbd-po.svn.sourceforge.net/svnroot/dbd-po/Locale-File-PO-Header/trunk/lib/Locale/PO/Utils.pm $
160              
161             =head1 VERSION
162              
163             0.003
164              
165             =head1 SYNOPSIS
166              
167             require Locale::PO::Utils;
168              
169             $obj = Locale::PO::Utils->new;
170              
171             =head1 DESCRIPTION
172              
173             Utils to build or extract the PO header
174              
175             The header of a PO file is quite complex.
176             This module helps to build the header and extract.
177              
178             =head1 SUBROUTINES/METHODS
179              
180             =head2 method msgstr - read and write the header as string
181              
182             =head3 reader
183              
184             $msgstr = $obj->msgstr;
185              
186             If nothing was set before it returns a minimal header:
187              
188             MIME-Version: 1.0
189             Content-Type: text/plain; charset=ISO-8859-1
190             Content-Transfer-Encoding: 8bit
191              
192             =head3 writer
193              
194             $obj->msgstr(<<'EOT');
195             Content-Type: text/plain; charset=UTF-8
196             EOT
197              
198             If nothing else was set before the msgstr is:
199              
200             MIME-Version: 1.0
201             Content-Type: text/plain; charset=UTF-8
202             Content-Transfer-Encoding: 8bit
203              
204             =head2 method all_keys - names of all items
205              
206             This sub returns all header keys you can set or get.
207              
208             @all_keys = $obj->all_keys;
209              
210             The returned array is:
211              
212             qw(
213             Project-Id-Version
214             Report-Msgid-Bugs-To_name
215             Report-Msgid-Bugs-To_address
216             POT-Creation-Date
217             PO-Revision-Date
218             Last-Translator_name
219             Last-Translator_address
220             Language-Team_name
221             Language-Team_address
222             MIME-Version
223             Content-Type
224             charset
225             Content-Transfer-Encoding
226             Plural-Forms
227             extended
228             )
229              
230             =head2 method data - modify lots of items
231              
232             $obj->data({
233             Project-Id-Version => 'Example',
234             Report-Msgid-Bugs-To_address => 'bug@example.com',
235             extended => {
236             X-Example => 'This is an example',
237             },
238             });
239              
240             If nothing else was set before the msgstr is:
241              
242             Project-Id-Version: Example
243             Report-Msgid-Bugs-To: bug@example.com
244             MIME-Version: 1.0
245             Content-Type: text/plain; charset=ISO-8859-1
246             Content-Transfer-Encoding: 8bit
247             X-Example: This is an example
248              
249             An example to write all keys:
250              
251             $obj->data({
252             'Project-Id-Version' => 'Testproject',
253             'Report-Msgid-Bugs-To_name' => 'Bug Reporter',
254             'Report-Msgid-Bugs-To_address' => 'bug@example.org',
255             'POT-Creation-Date' => 'no POT creation date',
256             'PO-Revision-Date' => 'no PO revision date',
257             'Last-Translator_name' => 'Steffen Winkler',
258             'Last-Translator_address' => 'steffenw@example.org',
259             'Language-Team_name' => 'MyTeam',
260             'Language-Team_address' => 'cpan@example.org',
261             'MIME-Version' => '1.0',
262             'Content-Type' => 'text/plain',
263             'charset' => 'utf-8',
264             'Content-Transfer-Encoding' => '8bit',
265             'extended' => [
266             'X-Poedit-Language' => 'German',
267             'X-Poedit-Country' => 'GERMANY',
268             'X-Poedit-SourceCharset' => 'utf-8',
269             ],
270             });
271              
272             The msgstr is:
273              
274             Project-Id-Version: Testproject
275             Report-Msgid-Bugs-To: Bug Reporter <bug@example.org>
276             POT-Creation-Date: no POT creation date
277             PO-Revision-Date: no PO revision date
278             Last-Translator: Steffen Winkler <steffenw@example.org>
279             Language-Team: MyTeam <cpan@example.org>
280             MIME-Version: 1.0
281             Content-Type: text/plain; charset=utf-8
282             Content-Transfer-Encoding: 8bit
283             X-Poedit-Language: German
284             X-Poedit-Country: GERMANY
285             X-Poedit-SourceCharset: utf-8
286              
287             =head2 method item - read or write one item
288              
289             =head3 writer
290              
291             $obj->item( 'Project-Id-Version' => 'Example' );
292              
293             =head3 reader
294              
295             $value = $obj->item('Project-Id-Version');
296              
297             =head2 method items - read lots of items
298              
299             @values = $obj->items( @keys );
300              
301             @values = $obj->items( qw(Project-Id-Version charset) );
302              
303             =head1 EXAMPLE
304              
305             Inside of this distribution is a directory named example.
306             Run the *.pl files.
307              
308             =head1 DIAGNOSTICS
309              
310             none
311              
312             =head1 CONFIGURATION AND ENVIRONMENT
313              
314             none
315              
316             =head1 DEPENDENCIES
317              
318             L<Moose|Moose>
319              
320             L<MooseX::StrictConstructor|MooseX::StrictConstructor>
321              
322             L<namespace::autoclean|namespace::autoclean>;
323              
324             L<syntax|syntax>
325              
326             L<Clone|Clone>
327              
328             =head1 INCOMPATIBILITIES
329              
330             not known
331              
332             =head1 BUGS AND LIMITATIONS
333              
334             not known
335              
336             =head1 SEE ALSO
337              
338             L<http://en.wikipedia.org/wiki/Gettext>
339              
340             =head1 AUTHOR
341              
342             Steffen Winkler
343              
344             =head1 LICENSE AND COPYRIGHT
345              
346             Copyright (c) 2011 - 2012,
347             Steffen Winkler
348             C<< <steffenw at cpan.org> >>.
349             All rights reserved.
350              
351             This module is free software;
352             you can redistribute it and/or modify it
353             under the same terms as Perl itself.