File Coverage

lib/Text/PO.pm
Criterion Covered Total %
statement 575 1227 46.8
branch 188 980 19.1
condition 64 360 17.7
subroutine 75 97 77.3
pod 46 46 100.0
total 948 2710 34.9


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## PO Files Manipulation - ~/lib/Text/PO.pm
3             ## Version v0.6.0
4             ## Copyright(c) 2023 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2018/06/21
7             ## Modified 2023/04/14
8             ## All rights reserved
9             ##
10             ## This program is free software; you can redistribute it and/or modify it
11             ## under the same terms as Perl itself.
12             ##----------------------------------------------------------------------------
13             package Text::PO;
14             BEGIN
15             {
16 4     4   22889853 use strict;
  4         15  
  4         144  
17 4     4   22 use warnings;
  4         14  
  4         128  
18 4     4   23 use warnings::register;
  4         9  
  4         541  
19 4     4   487 use parent qw( Module::Generic );
  4         303  
  4         39  
20 4     4   11533618 use vars qw( $VERSION @META $DEF_META );
  4         9  
  4         266  
21 4     4   1093 use open ':std' => ':utf8';
  4         2362  
  4         40  
22 4     4   1227 use Class::Struct;
  4         2052  
  4         54  
23 4     4   4664 use DateTime;
  4         2155045  
  4         236  
24 4     4   39 use DateTime::TimeZone;
  4         8  
  4         89  
25 4     4   47 use Encode ();
  4         8  
  4         88  
26 4     4   22 use Fcntl qw( :DEFAULT );
  4         9  
  4         1519  
27 4     4   2468 use JSON ();
  4         32057  
  4         151  
28 4     4   35 use Nice::Try;
  4         8  
  4         55  
29 4     4   10782194 use Scalar::Util;
  4         32  
  4         285  
30 4     4   2929 use Text::PO::Element;
  4         16  
  4         82  
31 4 50   4   1791 use constant HAS_LOCAL_TZ => ( eval( qq{DateTime::TimeZone->new( name => 'local' );} ) ? 1 : 0 );
  4         8  
  4         276  
32 4     4   16618 our $VERSION = 'v0.6.0';
33             };
34              
35 4     4   26 use strict;
  4         7  
  4         88  
36 4     4   28 use warnings;
  4         6  
  4         7404  
37              
38             struct 'Text::PO::Comment' =>
39             {
40             'text' => '@',
41             };
42             our @META = qw(
43             Project-Id-Version
44             Report-Msgid-Bugs-To
45             POT-Creation-Date
46             PO-Revision-Date
47             Last-Translator
48             Language-Team
49             Language
50             Plural-Forms
51             MIME-Version
52             Content-Type
53             Content-Transfer-Encoding
54             );
55             our $DEF_META =
56             {
57             'Project-Id-Version' => 'Project 0.1',
58             'Report-Msgid-Bugs-To' => 'bugs@example.com',
59             # 2011-07-02 20:53+0900
60             'POT-Creation-Date' => DateTime->from_epoch( 'epoch' => time(), 'time_zone' => ( HAS_LOCAL_TZ ? 'local' : 'UTC' ) )->strftime( '%Y-%m-%d %H:%M%z' ),
61             'PO-Revision-Date' => DateTime->from_epoch( 'epoch' => time(), 'time_zone' => ( HAS_LOCAL_TZ ? 'local' : 'UTC' ) )->strftime( '%Y-%m-%d %H:%M%z' ),
62             'Last-Translator' => 'Unknown <hello@example.com>',
63             'Language-Team' => 'Unknown <hello@example.com>',
64             'Language' => '',
65             'Plural-Forms' => 'nplurals=1; plural=0;',
66             'MIME-Version' => '1.0',
67             'Content-Type' => 'text/plain; charset=utf-8',
68             'Content-Transfer-Encoding' => '8bit',
69             };
70              
71             sub init
72             {
73 7     7 1 50663 my $self = shift( @_ );
74 7         333 $self->{domain} = '';
75 7         57 $self->{header} = [];
76             ## utf8
77 7         75 $self->{encoding} = '';
78 7         62 $self->{meta} = {};
79 7         66 $self->{meta_keys} = [];
80             ## Default to using po json file if it exists
81 7         55 $self->{use_json} = 1;
82 7         61 $self->{remove_duplicates} = 1;
83 7         45 $self->{_init_strict_use_sub} = 1;
84 7         101 $self->SUPER::init( @_ );
85 7         1029 $self->{elements} = [];
86 7         43 $self->{added} = [];
87 7         50 $self->{removed} = [];
88 7         51 $self->{source} = {};
89 7         55 return( $self );
90             }
91              
92             sub add_element
93             {
94 0     0 1 0 my $self = shift( @_ );
95 0         0 my $id;
96 0         0 my $opt = {};
97 0         0 my $e;
98 0 0 0     0 if( $self->_is_a( $_[0] => 'Text::PO::Element' ) )
    0          
    0          
99             {
100 0         0 $e = shift( @_ );
101 0         0 $id = $e->msgid;
102             }
103             elsif( scalar( @_ ) == 1 && ref( $_[0] ) eq 'HASH' )
104             {
105 0         0 $opt = shift( @_ );
106 0   0     0 $id = $opt->{msgid} || return( $self->error( "No msgid was provided" ) );
107 0         0 $e = Text::PO::Element->new( %$opt );
108             }
109             elsif( !( @_ % 2 ) )
110             {
111 0         0 $opt = { @_ };
112 0   0     0 $id = $opt->{msgid} || return( $self->error( "No msgid was provided" ) );
113 0         0 $e = Text::PO::Element->new( %$opt );
114             }
115             else
116             {
117 0         0 $id = shift( @_ );
118 0 0       0 $opt = { @_ } if( !( @_ % 2 ) );
119 0         0 $opt->{msgid} = $id;
120 0         0 $e = Text::PO::Element->new( %$opt );
121             }
122 0 0       0 return( $self->error( "No msgid was provided." ) ) if( !length( $id ) );
123 0         0 my $elem = $self->elements;
124 0         0 foreach my $e2 ( @$elem )
125             {
126 0         0 my $msgid = $e2->msgid;
127 0 0       0 my $thisId = ref( $msgid ) ? join( '', @$msgid ) : $msgid;
128 0 0       0 if( $thisId eq $id )
129             {
130             # return( $self->error( "There already is an id '$id' in the po file" ) );
131 0         0 return( $e2 );
132             }
133             }
134 0         0 $e->po( $self );
135 0         0 push( @{$self->{elements}}, $e );
  0         0  
136 0         0 return( $e );
137             }
138              
139 0     0 1 0 sub added { return( shift->_set_get_array_as_object( 'added', @_ ) ); }
140              
141 1     1 1 857 sub as_hash { return( shift->hash( @_ ) ); }
142              
143             sub as_json
144             {
145 1     1 1 2343 my $self = shift( @_ );
146 1         23 my $opts = $self->_get_args_as_hash( @_ );
147 1         19 my $metaKeys = $self->{meta_keys};
148 1         2 my $hash = {};
149 1         10 $hash->{domain} = $self->domain;
150 1         139 $hash->{meta} = {};
151 1         8 $hash->{meta_keys} = [];
152 1         6 $hash->{elements} = [];
153 1         11 foreach my $k ( @$metaKeys )
154             {
155 11         32 my $key = $self->normalise_meta( $k );
156 11         32 my $val = $self->meta( $k );
157 11         230 $hash->{meta}->{ $key } = $val;
158 11         19 push( @{$hash->{meta_keys}}, $key );
  11         35  
159             }
160 1         14 my $elem = $self->elements;
161 1         163 foreach my $e ( @$elem )
162             {
163 8         22 my $msgid = $e->msgid;
164 8         152 my $msgstr = $e->msgstr;
165 8 50 33     28 next if( $e->is_meta || !CORE::length( $e->msgid ) );
166 8 100       215 my $k = ref( $msgid ) ? join( '', @$msgid ) : $msgid;
167             # my $v = ref( $msgstr ) ? join( '', @$msgstr ) : $msgstr;
168 8         20 my $v;
169 8 100       27 if( $e->plural )
170             {
171 1         141 my $res = [];
172 1         85 for( my $i = 0; $i < scalar( @$msgstr ); $i++ )
173             {
174 2 50       34 push( @$res, ref( $msgstr->[$i] ) ? join( '', @{$msgstr->[$i]} ) : $msgstr->[$i] );
  2         38  
175             }
176 1         10 $v = $res;
177             }
178             else
179             {
180 7 100       1016 $v = ref( $msgstr ) ? join( '', @$msgstr ) : $msgstr;
181             }
182            
183 8         48 my $ref =
184             {
185             msgid => $k,
186             msgstr => $v,
187             };
188 8 100 66     34 $ref->{msgid_plural} = $e->msgid_plural if( $e->plural && $e->msgid_plural );
189 8 50       1177 if( !scalar( @{$ref->{comment} = $e->comment} ) )
  8         30  
190             {
191 8         175 delete( $ref->{comment} );
192             }
193 8 50       37 if( !length( $ref->{context} = $e->context ) )
194             {
195 8         986 delete( $ref->{context} );
196             }
197 8 50       10 if( !scalar( @{$ref->{flags} = $e->flags} ) )
  8         32  
198             {
199 8         162 delete( $ref->{flags} );
200             }
201 8 100       28 if( !length( $ref->{reference} = $e->reference ) )
202             {
203 5         8 delete( $ref->{reference} );
204             }
205 8         13 push( @{$hash->{elements}}, $ref );
  8         35  
206             }
207 1         123 my $j = JSON->new->relaxed->allow_blessed->convert_blessed;
208             # canonical = sorting hash keys
209 1         17 foreach my $t ( qw( pretty utf8 indent canonical ) )
210             {
211 4 50       22 $j->$t( $opts->{ $t } ) if( exists( $opts->{ $t } ) );
212             }
213 1 50       23 $j->canonical( $opts->{sort} ) if( exists( $opts->{sort} ) );
214 1 50 33     15 try
  1         6  
  1         4  
  1         65  
  0         0  
  1         15  
  1         17  
  1         8  
215 1     1   11 {
216 1         66 my $json = $j->encode( $hash );
217 1         26 return( $json );
218             }
219 1 0 0     40 catch( $e )
  0 0 33     0  
  0 0       0  
  1 0       6  
  1 0       3  
  1 0       9  
  1 0       9  
  1 0       27  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 50       0  
  0 50       0  
  0 50       0  
  0 50       0  
  0 50       0  
  0 0       0  
  0 50       0  
  0         0  
  0         0  
  0         0  
  1         18  
  0         0  
  1         11  
  0         0  
  0         0  
  1         15  
  1         24  
  1         4  
  1         11  
  0         0  
  0         0  
  0         0  
  0         0  
220 0     0   0 {
221 0         0 return( $self->error( "Unable to json encode the hash data created: $e" ) );
222 4 0 0 4   51 }
  4 0 0     9  
  4 0 33     5412  
  0 0 33     0  
  0 0 33     0  
  0 0 33     0  
  0 0 33     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 50       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  1 0       18  
  0 0       0  
  1 50       40  
  1 50       32  
  1 50       12  
  0 50       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  1         44  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
223             }
224              
225             sub charset
226             {
227 2     2 1 1024 my $self = shift( @_ );
228 2         28 my $type = $self->content_type();
229 2         51 my $def = $self->parse_header_value( $type );
230 2 50       25 if( @_ )
231             {
232 0         0 my $v = shift( @_ );
233 0         0 $def->params->{charset} = $v;
234 0         0 $self->meta( content_type => $def->as_string );
235             }
236 2         37 return( $def->params->{charset} );
237             }
238              
239 2     2 1 979 sub content_encoding { return( shift->_set_get_meta_value( 'Content-Transfer-Encoding' ) ); }
240              
241 4     4 1 769 sub content_type { return( shift->_set_get_meta_value( 'Content-Type' ) ); }
242              
243             # <https://superuser.com/questions/392439/lang-and-language-environment-variable-in-debian-based-systems>
244             sub current_lang
245             {
246 2     2 1 720 my $self = shift( @_ );
247 2 50 33     46 return( '' ) if( !CORE::exists( $ENV{LANGUAGE} ) && !CORE::exists( $ENV{LANG} ) );
248 0 0 0     0 return( ( $ENV{LANGUAGE} || $ENV{LANG} ) ? [split( /:/, ( $ENV{LANGUAGE} || $ENV{LANG} ) )]->[0] : '' );
      0        
249             }
250              
251             sub decode
252             {
253 0     0 1 0 my $self = shift( @_ );
254 0         0 my $str = shift( @_ );
255 0 0       0 return( '' ) if( !length( $str ) );
256 0         0 my $enc = $self->encoding;
257 0 0       0 return( $str ) if( !$enc );
258 0 0 0     0 try
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
259 0     0   0 {
260 0 0       0 return( Encode::decode_utf8( $str, Encode::FB_CROAK ) ) if( $enc eq 'utf8' );
261 0         0 return( Encode::decode( $enc, $str, Encode::FB_CROAK ) );
262             }
263 0 0 0     0 catch( $e )
  0 0 0     0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
264 0     0   0 {
265 0         0 return( $self->error( "An error occurred while trying to decode a string using encoding '$enc': $e" ) );
266 4 0 0 4   34 }
  4 0 0     16  
  4 0 0     13280  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
267             }
268              
269 11     11 1 12257 sub domain { return( shift->_set_get_scalar( 'domain', @_ ) ); }
270              
271             sub dump
272             {
273 1     1 1 50984 my $self = shift( @_ );
274 1         76 my $fh = IO::File->new;
275 1 50       82 if( @_ )
276             {
277 1         13 $fh = shift( @_ );
278 1 50       21 return( $self->error( "Filehandle provided '$fh' (", ref( $fh ), ") does not look like a filehandle" ) ) if( !Scalar::Util::openhandle( $fh ) );
279             # $fh->fdopen( fileno( $fh ), 'w' );
280             }
281             else
282             {
283 0         0 $fh->fdopen( fileno( STDOUT ), 'w' );
284             }
285 1   50     26 my $enc = $self->encoding || 'utf8';
286 1 50       171 $enc = 'utf8' if( lc( $enc ) eq 'utf-8' );
287 1 50       21 $fh->binmode( ":${enc}" ) || return( $self->error( "Unable to set binmode on character encoding '$enc': $!" ) );
288 1         196 $fh->autoflush(1);
289 1         202 my $elem = $self->{elements};
290 1 50       22 if( my $header = $self->header )
291             {
292 1 50       223 $fh->print( join( "\n", @$header ) ) || return( $self->error( "Unable to print po data to file handle: $!" ) );
293             }
294 1         320 my $domain = $self->domain;
295 1 50       153 if( length( $domain ) )
296             {
297 1 50       19 $fh->print( "\n#\n# domain \"${domain}\"" ) || return( $self->error( "Unable to print po data to file handle: $!" ) );
298             }
299 1 50       229 $fh->print( "\n\n" ) || return( $self->error( "Unable to print po data to file handle: $!" ) );
300             ## my $metaKeys = $self->meta_keys;
301 1         218 my $metaKeys = [@META];
302 1 50       18 if( scalar( @$metaKeys ) )
303             {
304 1 50       12 $fh->printf( "msgid \"\"\n" ) || return( $self->error( "Unable to print po data to file handle: $!" ) );
305 1 50       216 $fh->printf( "msgstr \"\"\n" ) || return( $self->error( "Unable to print po data to file handle: $!" ) );
306 1         203 foreach my $k ( @$metaKeys )
307             {
308 11         1936 my $k2 = lc( $k );
309 11         26 $k2 =~ tr/-/_/;
310 11 50 33     84 if( !exists( $self->{meta}->{ $k2 } ) &&
311             length( $DEF_META->{ $k } ) )
312             {
313 0         0 $self->{meta}->{ $k2 } = $DEF_META->{ $k };
314             }
315 11 50       271 $fh->printf( "\"%s: %s\\n\"\n", $self->normalise_meta( $k ), $self->meta( $k ) ) || return( $self->error( "Unable to print po data to file handle: $!" ) );
316             }
317 1 50       248 $fh->print( "\n" ) || return( $self->error( "Unable to print po data to file handle: $!" ) );
318             }
319 1         186 foreach my $e ( @$elem )
320             {
321 8 50 33     1227 next if( $e->is_meta || !CORE::length( $e->msgid ) );
322 8 50       225 if( $e->po ne $self )
323             {
324 0 0       0 warnings::warn( "This element '", $e->msgid, "' does not belong to us. Its po object is different than our current object.\n" ) if( warnings::enabled() );
325             }
326 8 50       203 $fh->print( $e->dump, "\n" ) || return( $self->error( "Unable to print po data to file handle: $!" ) );
327 8 50       1428 $fh->print( "\n" ) || return( $self->error( "Unable to print po data to file handle: $!" ) );
328             }
329 1         212 return( $self );
330             }
331              
332 10     10 1 22211 sub elements { return( shift->_set_get_array_as_object( 'elements', @_ ) ); }
333              
334 79     79 1 4640 sub encoding { return( shift->_set_get_scalar( 'encoding', @_ ) ); }
335              
336             sub exists
337             {
338 1     1 1 265 my $self = shift( @_ );
339 1   50     10 my $elem = shift( @_ ) || return( $self->error( "No element to check existence was provided." ) );
340 1 50       31 return( $self->error( "The element provided is not an Text::PO::Element object" ) ) if( !$self->_is_a( $elem => 'Text::PO::Element' ) );
341 1         125 my $opts = $self->_get_args_as_hash( @_ );
342 1   50     24 $opts->{msgid_only} //= 0;
343 1         6 my $elems = $self->{elements};
344             # No need to go further if the object provided does not even have a msgid
345 1 50       11 return(0) if( !length( $elem->msgid ) );
346 1         33 foreach my $e ( @$elems )
347             {
348 1 50 33     22 if( ( $opts->{msgid_only} && $e->msgid eq $elem->msgid ) ||
      33        
      33        
349             ( $e->msgid eq $elem->msgid && $e->msgstr eq $elem->msgstr ) )
350             {
351 1 50       13 if( length( $elem->context ) )
352             {
353 0 0       0 if( $elem->context eq $e->context )
354             {
355 0         0 return(1);
356             }
357             }
358             else
359             {
360 1         158 return(1);
361             }
362             }
363             }
364 0         0 return(0);
365             }
366              
367             sub hash
368             {
369 1     1 1 7 my $self = shift( @_ );
370 1         13 my $elem = $self->elements;
371 1         148 my $hash = {};
372 1         9 foreach my $e ( @$elem )
373             {
374 8         16 my $msgid = $e->msgid;
375 8         130 my $msgstr = $e->msgstr;
376 8 100       26 my $k = ref( $msgid ) ? join( '', @$msgid ) : $msgid;
377 8 100       25 my $v = ref( $msgstr ) ? join( '', @$msgstr ) : $msgstr;
378 8         25 $hash->{ $k } = $v;
379             }
380 1         15 return( $self->new_hash( $hash ) );
381             }
382              
383 3     3 1 50 sub header { return( shift->_set_get_array_as_object( 'header', @_ ) ); }
384              
385 2     2 1 41 sub language { return( shift->_set_get_meta_value( 'Language' ) ); }
386              
387 2     2 1 722 sub language_team { return( shift->_set_get_meta_value( 'Language-Team' ) ); }
388              
389 2     2 1 704 sub last_translator { return( shift->_set_get_meta_value( 'Last-Translator' ) ); }
390              
391             sub merge
392             {
393 0     0 1 0 my $self = shift( @_ );
394 0         0 my $opts = $self->_get_args_as_hash( @_ );
395 0         0 $opts->{merge} = 1;
396 0         0 return( $self->sync( $opts ) );
397             }
398              
399             sub meta
400             {
401 59     59 1 826 my $self = shift( @_ );
402 59 100       168 if( @_ )
403             {
404 54 100       288 if( $self->_is_hash( $_[0] ) )
    50          
    0          
405             {
406 4         76 $self->{meta} = shift( @_ );
407             }
408             elsif( scalar( @_ ) == 1 )
409             {
410 50         570 my $k = shift( @_ );
411 50         113 $k =~ tr/-/_/;
412 50         475 return( $self->{meta}->{ lc( $k ) } );
413             }
414             elsif( !( @_ % 2 ) )
415             {
416 0         0 my $this = { @_ };
417 0         0 foreach my $k ( keys( %$this ) )
418             {
419 0         0 my $k2 = $k;
420 0         0 $k2 =~ tr/-/_/;
421 0         0 $self->{meta}->{ lc( $k2 ) } = $this->{ $k };
422             }
423             }
424             else
425             {
426 0         0 return( $self->error( "Unknown data provided: '", join( "', '", @_ ), "'." ) );
427             }
428            
429 4         13 foreach my $k ( keys( %{$self->{meta}} ) )
  4         73  
430             {
431 34 100       128 if( CORE::index( $k, '-' ) != -1 )
432             {
433 31         53 my $k2 = $k;
434 31         58 $k2 =~ tr/-/_/;
435 31         133 $self->{meta}->{ $k2 } = CORE::delete( $self->{meta}->{ $k } );
436             }
437             }
438             }
439 9         79 return( $self->_set_get_hash_as_mix_object( 'meta' ) );
440             }
441              
442             sub meta_keys
443             {
444 3     3 1 11831 my $self = shift( @_ );
445 3 100       21 if( @_ )
446             {
447 1         3 my $ref = shift( @_ );
448 1 50       11 return( $self->error( "Value provided is not an array reference." ) ) if( !$self->_is_array( $ref ) );
449 1         22 my $copy = [@$ref];
450 1         5 for( @$copy )
451             {
452 1         8 tr/-/_/;
453 1         5 $_ = lc( $_ );
454             }
455 1         3 $self->{meta_keys} = $copy;
456             }
457 3         18 my $data = $self->{meta_keys};
458 3 50       24 $data = [sort( keys( %{$self->{meta}} ) )] if( !scalar( @$data ) );
  0         0  
459 3         13 my $new = [];
460 3         18 for( @$data )
461             {
462 23         68 push( @$new, $self->normalise_meta( $_ ) );
463             }
464 3         63 return( $self->new_array( $new ) );
465             }
466              
467 2     2 1 10947 sub mime_version { return( shift->_set_get_meta_value( 'MIME-Version' ) ); }
468              
469             sub new_element
470             {
471 9     9 1 19 my $self = shift( @_ );
472 9         26 my $opts = $self->_get_args_as_hash( @_ );
473 9         1083 $opts->{po} = $self;
474 9         38 my $e = Text::PO::Element->new( $opts );
475 9 50 33     72 $e->encoding( $self->encoding ) if( !$opts->{encoding} && $self->encoding );
476 9         1062 $e->debug( $self->debug );
477 9         331 return( $e );
478             }
479              
480             sub normalise_meta
481             {
482 46     46 1 749 my $self = shift( @_ );
483 46   50     165 my $str = shift( @_ ) || return( '' );
484 46         94 $str =~ tr/_/-/;
485 46         1211 my @res = grep( /^$str$/i, @META );
486 46 100       154 if( scalar( @res ) )
487             {
488 45         173 return( $res[0] );
489             }
490 1         5 return( '' );
491             }
492              
493             sub parse
494             {
495 3     3 1 3760616 my $self = shift( @_ );
496 3   50     26 my $this = shift( @_ ) || return( $self->error( "No file or glob was provided to parse po file." ) );
497 3         128 my $io;
498 3         18 my $fh_was_open = 0;
499 3 50       121 if( Scalar::Util::reftype( $this ) eq 'GLOB' )
500             {
501 0         0 $io = $this;
502 0 0       0 return( $self->error( "Filehandle provided '$io' is not opened" ) ) if( !Scalar::Util::openhandle( $io ) );
503 0         0 $fh_was_open++;
504 0         0 $self->source({ handle => $this });
505             }
506             else
507             {
508 3   50     41 $io = IO::File->new( "<$this" ) || return( $self->error( "Unable to open po file \"$this\" in read mode: $!" ) );
509             ## By default
510 3         961 $self->source({ file => $this });
511             }
512 3         13109 $io->binmode( ':utf8' );
513 3         92 my $elem = [];
514 3         33 $self->{elements} = $elem;
515 3         139 my $header = '';
516 3         22 my $ignoring_leading_blanks = 1;
517 3         20 my $n = 0;
518             # Ignore / remove possible leading blank lines
519 3         192 while( defined( $_ = $io->getline ) )
520             {
521 15         893 $n++;
522 15 100 33     109 if( /^\S+/ )
    50          
523             {
524 13         43 $ignoring_leading_blanks = 0;
525             }
526             elsif( $ignoring_leading_blanks && /^[[:blank:]\h]*$/ )
527             {
528 0         0 next;
529             }
530             #( 1 .. /^[^\#]+$/ ) or last;
531 15 100       69 /^\#+/ || last;
532 12 100       50 if( /^\#+[[:blank:]\h]*domain[[:blank:]]+\"([^\"]+)\"/ )
533             {
534 2         82 $self->domain( $1 );
535 2         370 $self->message_colour( 3, "Setting domain to <green>$1</>" );
536             }
537             else
538             {
539 10         47 $header .= $_;
540             }
541             }
542             # Remove trailing blank lines from header
543 3         49 $header =~ s/(^[[:blank:]\h]*\#[[:blank:]\h]*\n$)+\Z//gms;
544             ## Make sure to position ourself after the initial blank line if any, since blank lines are used as separators
545             ## Actually, no we don't care. Blocks are: maybe some comments, msgid then msgstr. That's how we delimit them
546             ## $_ = $io->getline while( /^[[:blank:]]*$/ && defined( $_ ) );
547 3 100       106 $self->header( [ split( /\n/, $header ) ] ) if( length( $header ) );
548 3         626 my $e = Text::PO::Element->new( po => $self );
549 3         34 $e->debug( $self->debug );
550             ## What was the last seen element?
551             ## This is used for multi line buffer, so we know where to add it
552 3         166 my $lastSeen = '';
553 3         16 my $foundFirstLine = 0;
554             ## To keep track of the msgid found so we can skip duplicates
555 3         18 my $seen = {};
556 3         59 while( defined( $_ = $io->getline ) )
557             {
558 128         1036 $n++;
559 128         179 chomp( $_ );
560 128 100 66     329 if( !$foundFirstLine && /^\S/ )
561             {
562 3         14 $foundFirstLine++;
563             }
564 128 100       1286 if( /^[[:blank:]]*$/ )
    50          
    100          
    50          
    50          
    100          
    100          
    100          
    100          
    100          
    50          
565             {
566 21 50       52 if( $foundFirstLine )
567             {
568             ## Case where msgid and msgstr are separated by a blank line
569 21 50 66     127 if( scalar( @$elem ) > 1 &&
      33        
      33        
      0        
570             !length( $e->msgid ) &&
571             length( $e->msgstr ) &&
572             length( $elem->[-1]->msgid ) &&
573             !length( $elem->[-1]->msgstr ) )
574             {
575 0         0 $elem->[-1]->merge( $e );
576             }
577             else
578             {
579 21 50       383 if( ++$seen->{ $e->id } > 1 )
580             {
581 0         0 next;
582             }
583 21         62 push( @$elem, $e );
584             }
585 21         98 $e = Text::PO::Element->new( po => $self );
586 21         115 $e->{_po_line} = $n;
587 21 100       86 $e->encoding( $self->encoding ) if( $self->encoding );
588 21         2691 $e->debug( $self->debug );
589             }
590             ## special treatment for first item that contains the meta information
591 21 100       839 if( scalar( @$elem ) == 1 )
592             {
593 3         32 my $this = $elem->[0];
594 3         29 my $def = $this->msgstr;
595 3         71 $def = [split( /\n/, join( '', @$def ) )];
596            
597 3         24 my $meta = {};
598 3         25 foreach my $s ( @$def )
599             {
600 33         58 chomp( $s );
601 33 50       190 if( $s =~ /^([^\x00-\x1f\x80-\xff :=]+):[[:blank:]]*(.*?)$/ )
602             {
603 33         157 my( $k, $v ) = ( lc( $1 ), $2 );
604 33         197 $meta->{ $k } = $v;
605 33         45 push( @{$self->{meta_keys}}, $k );
  33         89  
606 33 100       104 if( $k eq 'content-type' )
607             {
608 3 50       53 if( $v =~ /\bcharset=\s*([-\w]+)/i )
609             {
610             # my $enc = lc( $1 );
611 3         9 my $enc = $1;
612             ## See PerlIO::encoding man page
613 3 50       34 $enc = 'utf8' if( lc( $enc ) eq 'utf-8' );
614 3         18 $self->encoding( $enc );
615 3 50 33     452 try
  3         13  
  3         6  
  3         45  
  0         0  
  3         8  
  3         25  
  3         18  
616 3     3   6 {
617 3 50       48 $io->binmode( $enc eq 'utf8' ? ":$enc" : ":encoding($enc)" );
618             }
619 3 50 100     69 catch( $e )
  3 0 33     94  
  1 0       5  
  3 0       8  
  3 0       4  
  3 0       17  
  3 0       11  
  3 0       35  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 50       0  
  0 50       0  
  0 100       0  
  0 50       0  
  0 50       0  
  0 50       0  
  0 0       0  
  0 50       0  
  0         0  
  0         0  
  0         0  
  3         28  
  0         0  
  1         3  
  2         8  
  2         10  
  3         13  
  3         31  
  3         11  
  3         15  
  0         0  
  0         0  
  0         0  
  0         0  
620 0     0   0 {
621 0         0 return( $self->error( "Unable to set binmode to charset \"$enc\": $e" ) );
622 4 0 0 4   36 }
  4 0 0     9  
  4 0 66     9211  
  0 0 33     0  
  0 0 66     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 50       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  3 0       18  
  0 0       0  
  3 0       111  
  0 0       0  
  0 0       0  
  0 50       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 50       0  
  0 50       0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  3         13  
  0         0  
  0         0  
  0         0  
  0         0  
  3         33  
623             }
624             }
625             }
626             }
627 3 50       31 if( scalar( keys( %$meta ) ) )
628             {
629 3         18 $self->meta( $meta );
630 3         3063 $this->is_meta( 1 );
631             }
632             }
633             }
634             ## #. TRANSLATORS: A test phrase with all letters of the English alphabet.
635             ## #. Replace it with a sample text in your language, such that it is
636             ## #. representative of language's writing system.
637             elsif( /^\#\.[[:blank:]]*(.*?)$/ )
638             {
639 0         0 my $c = $1;
640 0         0 $e->add_auto_comment( $c );
641             }
642             ## #: finddialog.cpp:38
643             ## #: colorscheme.cpp:79 skycomponents/equator.cpp:31
644             elsif( /^\#\:[[:blank:]]+(.*?)$/ )
645             {
646 9         27 my $c = $1;
647 9         56 $e->reference( $c );
648             }
649             ## #, c-format
650             elsif( /^\#\,[[:blank:]]+(.*?)$/ )
651             {
652 0         0 my $c = $1;
653 0 0       0 $e->flags( [ split( /[[:blank:]]*,[[:blank:]]*/, $c ) ] ) if( $c );
654             }
655             elsif( /^\#+[[:blank:]]+(.*?)$/ )
656             {
657 0         0 my $c = $1;
658 0 0 0     0 if( !$self->meta->length && $c =~ /^domain[[:blank:]\h]+\"(.*?)\"/ )
659             {
660 0         0 $self->domain( $1 );
661             }
662             else
663             {
664 0         0 $e->add_comment( $c);
665             }
666             }
667             elsif( /^msgid[[:blank:]]+"(.*?)"$/ )
668             {
669 22 100       119 $e->msgid( $self->unquote( $1 ) ) if( length( $1 ) );
670 22         478 $lastSeen = 'msgid';
671             }
672             ## #: mainwindow.cpp:127
673             ## #, kde-format
674             ## msgid "Time: %1 second"
675             ## msgid_plural "Time: %1 seconds"
676             ## msgstr[0] "Tiempo: %1 segundo"
677             ## msgstr[1] "Tiempo: %1 segundos"
678             elsif( /^msgid_plural[[:blank:]]+"(.*?)"[[:blank:]]*$/ )
679             {
680 3 50       45 $e->msgid_plural( $self->unquote( $1 ) ) if( length( $1 ) );
681 3         91 $e->plural(1);
682 3         795 $lastSeen = 'msgid_plural';
683             }
684             ## disambiguating context:
685             ## #: tools/observinglist.cpp:700
686             ## msgctxt "First letter in 'Scope'"
687             ## msgid "S"
688             ## msgstr ""
689             ##
690             ## #: skycomponents/horizoncomponent.cpp:429
691             ## msgctxt "South"
692             ## msgid "S"
693             ## msgstr ""
694             elsif( /^msgctxt[[:blank:]]+"(.*?)"[[:blank:]]*$/ )
695             {
696 2 50       43 $e->context( $self->unquote( $1 ) ) if( length( $1 ) );
697 2         489 $lastSeen = 'msgctxt';
698             }
699             elsif( /^msgstr[[:blank:]]+"(.*?)"[[:blank:]]*$/ )
700             {
701 20 100       114 $e->msgstr( $self->unquote( $1 ) ) if( length( $1 ) );
702 20         92 $lastSeen = 'msgstr';
703             }
704             elsif( /^msgstr\[(\d+)\][[:blank:]]+"(.*?)"[[:blank:]]*$/ )
705             {
706 8 50       51 if( length( $2 ) )
707             {
708 8         37 $e->msgstr( $1, $self->unquote( $2 ) );
709 8         29 $e->plural(1);
710             }
711 8         2160 $lastSeen = 'msgstr';
712             }
713             elsif( /^[[:blank:]]*"(.*?)"[[:blank:]]*$/ )
714             {
715 43         101 my $sub = "add_${lastSeen}";
716 43 50       145 if( $e->can( $sub ) )
717             {
718 43 50       211 $e->$sub( $self->unquote( $1 ) ) if( length( $1 ) );
719             }
720             else
721             {
722 0         0 warn( "Unable to find method \"${sub}\" in class \"", ref( $e ), "\" for line parsed \"$_\"\n" );
723             }
724             }
725             else
726             {
727 0 0       0 warnings::warn( "I do not understand the line \"$_\" at line $n\n" ) if( warnings::enabled() );
728             }
729             }
730 3 50       47 $io->close unless( $fh_was_open );
731 3 100 66     136 push( @$elem, $e ) if( $elem->[-1] ne $e && CORE::length( $e->msgid ) && ++$seen->{ $e->msgid } < 2 );
      66        
732 3 50 33     103 shift( @$elem ) if( scalar( @$elem ) && $elem->[0]->is_meta );
733 3         567 return( $self );
734             }
735              
736             sub parse_date_to_object
737             {
738 4     4 1 16 my $self = shift( @_ );
739 4         16 my $str = shift( @_ );
740 4   50     120 my $d = $self->_parse_timestamp( $str ) ||
741             return( $self->error( "Date time string provided is unsupported: \"${str}\"." ) );
742 4         8461353 my $strp = $d->formatter;
743 4 50       37 unless( $strp )
744             {
745 0         0 $strp = DateTime::Format::Strptime->new(
746             pattern => '%Y-%m-%d %H:%M%z',
747             locale => 'en_GB',
748             time_zone => $d->time_zone,
749             );
750 0         0 $d->set_formatter( $strp );
751             }
752 4         146 return( $d );
753             }
754              
755             sub parse_header_value
756             {
757 2     2 1 11 my $self = shift( @_ );
758 2         10 my $s = shift( @_ );
759 2 50 33     33 return( $self->error( 'Argument string is required' ) ) if( !defined( $s ) || !length( $s ) );
760 2 50       22 my $sep = @_ ? shift( @_ ) : ';';
761 2         12 my @parts = ();
762 2         5 my $i = 0;
763 2         82 foreach( split( /(\\.)|$sep/, $s ) )
764             {
765 6 100       16 defined( $_ ) ? do{ $parts[$i] .= $_ } : do{ $i++ };
  4         13  
  2         3  
766             }
767 2         7 my $header_val = shift( @parts );
768 2         46 my $obj = Text::PO::HeaderValue->new( $header_val );
769            
770 2         19 my $param = {};
771 2         16 foreach my $frag ( @parts )
772             {
773 2         35 $frag =~ s/^[[:blank:]]+|[[:blank:]]+$//g;
774 2         37 my( $attribute, $value ) = split( /[[:blank:]]*\=[[:blank:]]*/, $frag, 2 );
775 2         14 $value =~ s/^\"|\"$//g;
776             ## Check character string and length. Should not be more than 255 characters
777             ## http://tools.ietf.org/html/rfc1341
778             ## http://www.iana.org/assignments/media-types/media-types.xhtml
779             ## Won't complain if this does not meet our requirement, but will discard it silently
780 2 50 33     48 if( $attribute =~ /^[a-zA-Z][a-zA-Z0-9\_\-]+$/ && CORE::length( $attribute ) <= 255 )
781             {
782 2 50 33     35 if( $value =~ /^[a-zA-Z][a-zA-Z0-9\_\-]+$/ && CORE::length( $value ) <= 255 )
783             {
784 2         42 $obj->param( lc( $attribute ) => $value );
785             }
786             }
787             }
788 2         18 return( $obj );
789             }
790              
791             sub parse2hash
792             {
793 0     0 1 0 my $self = shift( @_ );
794 0   0     0 my $this = shift( @_ ) || return( $self->error( "No file or glob was provided to parse po file." ) );
795 0         0 my $buff = '';
796 0 0 0     0 if( $self->{use_json} && ( -e( "${this}.json" ) || $this =~ /\.json$/ ) )
      0        
797             {
798 0 0       0 my $file = -e( "${this}.json" ) ? "${this}.json" : $this;
799 0   0     0 my $io = IO::File->new( "$file" ) || return( $self->error( "Unable to open json po file \"${file}\" in read mode: $!" ) );
800 0         0 $io->binmode( ':utf8' );
801 0         0 $io->read( $buff, -s( $file ) );
802 0         0 $io->close;
803 0         0 my $j = JSON->new->relaxed;
804 0         0 my $ref = {};
805 0 0 0     0 try
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
806 0     0   0 {
807 0         0 $ref = $j->decode( $buff );
808             }
809 0 0 0     0 catch( $e )
  0 0 0     0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
810 0     0   0 {
811 0         0 return( $self->error( "An error occurred while json decoding data from \"${file}\": $e" ) );
812 4 0 0 4   50 }
  4 0 0     8  
  4 0 0     4997  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
813 0         0 my $hash = {};
814 0         0 foreach my $elem ( @{$ref->{elements}} )
  0         0  
815             {
816 0         0 $hash->{ $elem->{msgid} } = $elem->{msgstr};
817             }
818 0         0 return( $self->new_hash( $hash ) );
819             }
820             else
821             {
822 0 0       0 $self->parse( $this ) || return( $self->pass_error );
823 0         0 return( $self->hash );
824             }
825             }
826              
827             sub parse2object
828             {
829 2     2 1 24 my $self = shift( @_ );
830 2   50     19 my $this = shift( @_ ) || return( $self->error( "No file or glob was provided to parse po file." ) );
831 2         55 my $buff = '';
832 2 50 33     17 if( $self->{use_json} && ( -e( "${this}.json" ) || $this =~ /\.json$/ ) )
      33        
833             {
834 2 50       243 my $file = -e( "${this}.json" ) ? "${this}.json" : $this;
835 2   50     167 my $io = IO::File->new( $file ) || return( $self->error( "Unable to open json po file \"${file}\" in read mode: $!" ) );
836 2         815 $io->binmode( ':utf8' );
837 2         62 $io->read( $buff, -s( $file ) );
838 2         298 $io->close;
839 2         166 my $j = JSON->new->relaxed;
840 2         16 my $ref = {};
841 2 50 33     29 try
  2         13  
  2         29  
  2         86  
  0         0  
  2         14  
  2         54  
  2         21  
842 2     2   10 {
843 2         198 $ref = $j->decode( $buff );
844             }
845 2 0 50     45 catch( $e )
  2 0 33     22  
  2 0       19  
  2 0       25  
  2 0       7  
  2 0       7  
  2 0       21  
  2 0       39  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 50       0  
  0 50       0  
  0 50       0  
  0 50       0  
  0 50       0  
  0 0       0  
  0 50       0  
  0         0  
  0         0  
  0         0  
  2         11  
  0         0  
  2         10  
  0         0  
  0         0  
  2         24  
  2         32  
  2         11  
  2         17  
  0         0  
  0         0  
  0         0  
  0         0  
846 0     0   0 {
847 0         0 return( $self->error( "An error occurred while json decoding data from \"${file}\": $e" ) );
848 4 0 0 4   36 }
  4 0 0     9  
  4 0 33     8474  
  0 0 33     0  
  0 0 33     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 50       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  2 0       16  
  0 0       0  
  2 0       145  
  0 0       0  
  0 0       0  
  0 50       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 50       0  
  0 50       0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  2         19  
  0         0  
  0         0  
  0         0  
  0         0  
  2         18  
849            
850 2 50 33     39 $self->domain( $ref->{domain} ) if( length( $ref->{domain} ) && !length( $self->domain ) );
851 2         333 my $meta_keys = [];
852 2 50       16 if( $ref->{meta_keys} )
    0          
853             {
854 2         16 $meta_keys = $ref->{meta_keys};
855             }
856             elsif( $ref->{meta} )
857             {
858 0         0 $meta_keys = [sort( keys( %{$ref->{meta}} ) )];
  0         0  
859             }
860            
861 2 50       22 if( $ref->{meta} )
862             {
863 2         16 $self->{meta} = {};
864 2         11 foreach my $k ( keys( %{$ref->{meta}} ) )
  2         31  
865             {
866 22         65 my $k2 = lc( $k );
867 22         43 $k2 =~ tr/-/_/;
868 22         140 $self->{meta}->{ $k2 } = $ref->{meta}->{ $k };
869             }
870             }
871 2         15 $self->{meta_keys} = $meta_keys;
872            
873 2 50       22 if( scalar( @$meta_keys ) )
874             {
875 2         51 my $e = Text::PO::Element->new( 'po' => $self );
876 2         24 $e->debug( $self->debug );
877 2         104 $e->msgid( '' );
878             $e->msgstr(
879 2         150 [map( sprintf( '%s: %s', $_, $ref->{meta}->{ $_ } ), @$meta_keys )]
880             );
881 2         27 $e->is_meta(1);
882 2         361 push( @{$self->{elements}}, $e );
  2         7  
883             }
884            
885 2         10 foreach my $def ( @{$ref->{elements}} )
  2         11  
886             {
887 16         75 my $e = Text::PO::Element->new( 'po' => $self );
888 16         124 $e->debug( $self->debug );
889 16         574 $e->msgid( $def->{msgid} );
890 16 100       337 if( $def->{msgid_plural} )
891             {
892 2         53 $e->msgid_plural( $def->{msgid_plural} );
893             }
894 16 100       104 if( ref( $def->{msgstr} ) eq 'ARRAY' )
895             {
896 2         16 for( my $i = 0; $i < scalar( @{$def->{msgstr}} ); $i++ )
  5         32  
897             {
898 3         21 $e->msgstr( $i => $def->{msgstr}->[$i] );
899             }
900             }
901             else
902             {
903 14         34 $e->msgstr( $def->{msgstr} );
904             }
905 16 50       52 $e->comment( $def->{comment} ) if( $def->{comment} );
906 16 50       47 $e->context( $def->{context} ) if( $def->{context} );
907 16 50       59 $e->flags( $def->{flags} ) if( $def->{flags} );
908 16 100       66 $e->reference( $def->{reference} ) if( $def->{reference} );
909 16 50       47 $e->encoding( $self->encoding ) if( $self->encoding );
910 16         2174 push( @{$self->{elements}}, $e );
  16         58  
911             }
912 2         61 return( $self );
913             }
914             else
915             {
916 0         0 return( $self->parse( $this ) );
917             }
918             }
919              
920             sub plural
921             {
922 2     2 1 18 my $self = shift( @_ );
923 2 50       15 if( @_ )
924             {
925 0         0 my( $nplurals, $expr ) = @_;
926 0         0 $self->{plural} = [ $nplurals, $expr ];
927 0         0 return( [ @{$self->{plural}} ] );
  0         0  
928             }
929             else
930             {
931 2 0 50     18 return( [@{$self->{plural}}] ) if( $self->{plural} && scalar( @{$self->{plural}} ) );
  0         0  
  0         0  
932 2         22 my $meta = $self->meta;
933 2         1015 my $pluralDef = $self->meta( 'Plural-Forms' );
934 2 50       93 if( $pluralDef )
935             {
936 2 50       43 if( $pluralDef =~ /^[[:blank:]\h]*nplurals[[:blank:]\h]*=[[:blank:]\h]*(\d+)[[:blank:]\h]*\;[[:blank:]\h]*plural[[:blank:]\h]*=[[:blank:]\h]*(.*?)\;?$/i )
937             {
938 2         21 $self->{plural} = [ $1, $2 ];
939 2         26 return( $self->{plural} );
940             }
941             else
942             {
943 0         0 return( $self->error( "Malformed plural definition found in po data in meta field \"Plural-Forms\": " . $pluralDef ) );
944             }
945             }
946 0         0 return( [] );
947             }
948             }
949              
950 3     3 1 2074 sub plural_forms { return( shift->_set_get_meta_value( 'Plural-Forms', @_ ) ); }
951              
952 3     3 1 1840 sub po_revision_date { return( shift->_set_get_meta_date( 'PO-Revision-Date', @_ ) ); }
953              
954 1     1 1 6 sub pot_creation_date { return( shift->_set_get_meta_date( 'POT-Creation-Date', @_ ) ); }
955              
956 2     2 1 16 sub project_id_version { return( shift->_set_get_meta_value( 'Project-Id-Version', @_ ) ); }
957              
958 2     2 1 702 sub report_bugs_to { return( shift->_set_get_meta_value( 'Report-Msgid-Bugs-To', @_ ) ); }
959              
960             sub quote
961             {
962 20     20 1 411 my $self = shift( @_ );
963 20         24 my $str = shift( @_ );
964 20 50       56 return( '' ) if( !length( $str ) );
965             ## \t is a tab
966 20         50 $str =~ s/(?<!\\)\\(?!t)/\\\\/g;
967 20         37 $str =~ s/(?<!\\)"/\\"/g;
968 20         35 $str =~ s/(?<!\\)\n/\\n/g;
969 20         109 return( sprintf( '%s', $str ) );
970             }
971              
972 0     0 1 0 sub remove_duplicates { return( shift->_set_get_boolean( 'remove_duplicates', @_ ) ); }
973              
974             sub remove_element
975             {
976 0     0 1 0 my $self = shift( @_ );
977 0         0 my $elem = shift( @_ );
978 0         0 my $rv = $self->exists( $elem );
979 0 0       0 return if( !defined( $rv ) );
980 0 0       0 return(0) if( !$rv );
981 0         0 my $elems = $self->elements;
982 0         0 my $found = 0;
983 0         0 for( my $i = 0; $i < scalar( @$elems ); $i++ )
984             {
985 0 0       0 if( $elems->[$i] eq $elem )
986             {
987 0         0 splice( @$elems, $i, 1 );
988 0         0 $i--;
989 0         0 $found++;
990             }
991             }
992 0         0 return( $found );
993             }
994              
995 0     0 1 0 sub removed { return( shift->_set_get_array_as_object( 'removed', @_ ) ); }
996              
997 3     3 1 140 sub source { return( shift->_set_get_hash_as_object( 'source', @_ ) ); }
998              
999             sub sync
1000             {
1001 0     0 1 0 my $self = shift( @_ );
1002             # a filehandle, or a filename?
1003             # my $this = shift( @_ ) || return( $self->error( "No file or filehandle provided." ) );
1004 0         0 my $this;
1005 0 0 0     0 $this = shift( @_ ) if( scalar( @_ ) && ( ( @_ % 2 ) || ( !( @_ % 2 ) && ref( $_[1] ) eq 'HASH' ) ) );
      0        
1006 0         0 my $opts = $self->_get_args_as_hash( @_ );
1007 0 0 0     0 $this = ( $opts->{handle} || $opts->{file} ) if( !CORE::length( $this ) );
1008 0 0       0 if( !$this )
1009             {
1010 0         0 my $fh;
1011 0 0       0 if( $fh = $self->source->handle )
    0          
1012             {
1013 0 0       0 $this = $fh if( $self->_can_write_fh( $fh ) );
1014             }
1015             elsif( my $file = $self->source->file )
1016             {
1017 0 0 0     0 $this = $file if( -e( $file ) && -w( $file ) );
1018 0   0     0 $fh = IO::File->new( ">$file" ) || return( $self->error( "Unable to open file \"$file\" in write mode: $!" ) );
1019             }
1020 0 0       0 return( $self->error( "No writable file handle or file set to sync our data against." ) ) if( !$this );
1021 0         0 $fh->binmode( ':utf8' );
1022 0 0       0 $self->dump( $fh ) || return( $self->pass_error );
1023 0         0 $fh->close;
1024 0         0 return( $self );
1025             }
1026            
1027 0 0       0 if( Scalar::Util::reftype( $this ) eq 'GLOB' )
    0          
    0          
1028             {
1029 0 0       0 return( $self->error( "Filehandle provided is not opened" ) ) if( !Scalar::Util::openhandle( $this ) );
1030 0 0       0 return( $self->error( "Filehandle provided is not writable" ) ) if( !$self->_can_write_fh( $this ) );
1031 0         0 return( $self->sync_fh( $this, $opts ) );
1032             }
1033             elsif( -l( $this ) )
1034             {
1035 0         0 return( $self->error( "File provided is actually a symbolic link. Do not want to write to a symbolic link." ) );
1036             }
1037             elsif( -e( $this ) )
1038             {
1039 0 0       0 if( !-f( $this ) )
1040             {
1041 0         0 return( $self->error( "File '$this' is not a file." ) );
1042             }
1043 0   0     0 my $fh = IO::File->new( "+<$this" ) || return( $self->error( "Unable to open file '$this' in read/write mode: $!" ) );
1044 0         0 my $po = $self->sync_fh( $fh, $opts );
1045 0         0 $fh->close;
1046 0         0 return( $po );
1047             }
1048             # Does not exist yet
1049             else
1050             {
1051 0   0     0 my $fh = IO::File->new( ">$this" ) || return( $self->error( "Unable to write to file '$this': $!" ) );
1052 0 0       0 $self->dump( $fh ) || return( $self->pass_error );
1053 0         0 $fh->close;
1054             }
1055 0         0 return( $self );
1056             }
1057              
1058             sub sync_fh
1059             {
1060 0     0 1 0 my $self = shift( @_ );
1061 0         0 my $fh = shift( @_ );
1062 0 0       0 return( $self->error( "Filehandle provided $fh is not a valid file handle" ) ) if( !Scalar::Util::openhandle( $fh ) );
1063 0         0 my $opts = $self->_get_args_as_hash( @_ );
1064             # Parse file
1065 0         0 my $po = $self->new;
1066 0         0 $po->debug( $self->debug );
1067 0         0 $po->parse( $fh );
1068             # Remove the ones that do not exist
1069 0         0 my $elems = $po->elements;
1070 0         0 my @removed = ();
1071 0         0 for( my $i = 0; $i < scalar( @$elems ); $i++ )
1072             {
1073 0         0 my $e = $elems->[$i];
1074 0 0       0 if( !$self->exists( $e, { msgid_only => 1 } ) )
1075             {
1076 0         0 my $removedObj = splice( @$elems, $i, 1 );
1077 0 0       0 push( @removed, $removedObj ) if( $removedObj );
1078             }
1079             }
1080             # Now check each one of ours against this parsed file and add our items if missing
1081 0         0 $elems = $self->elements;
1082 0         0 my @added = ();
1083 0         0 foreach my $e ( @$elems )
1084             {
1085 0 0       0 if( !$po->exists( $e, { msgid_only => 1 } ) )
1086             {
1087 0         0 $po->add_element( $e );
1088 0         0 push( @added, $e );
1089             }
1090             }
1091             # Now, rewind and rewrite the file
1092 0 0       0 $fh->seek(0,0) || return( $self->error( "Unable to seek file handle!: $!" ) );
1093             # $fh->print( $po->dump );
1094 0 0       0 $po->dump( $fh ) || return( $self->pass_error );
1095 0         0 $fh->truncate( $fh->tell );
1096 0         0 $po->added( \@added );
1097 0         0 $po->removed( \@removed );
1098 0         0 return( $po );
1099             }
1100              
1101             sub unquote
1102             {
1103 89     89 1 164 my $self = shift( @_ );
1104 89         201 my $str = shift( @_ );
1105 89 50       215 return( '' ) if( !length( $str ) );
1106 89         191 $str =~ s/^"(.*)"/$1/;
1107 89         159 $str =~ s/\\"/"/g;
1108             ## newline
1109 89         249 $str =~ s/(?<!(\\))\\n/\n/g;
1110             ## inline newline
1111 89         154 $str =~ s/(?<!(\\))\\{2}n/\\n/g;
1112             ## \ followed by newline
1113 89         120 $str =~ s/(?<!(\\))\\{3}n/\\\n/g;
1114             ## \ followed by inline newline
1115 89         131 $str =~ s/\\{4}n/\\\\n/g;
1116             ## all slashes not related to a newline
1117 89         124 $str =~ s/\\\\(?!n)/\\/g;
1118 89         368 return( $str );
1119             }
1120              
1121 2     2 1 639 sub use_json { return( shift->_set_get_boolean( 'use_json', @_ ) ); }
1122              
1123             ## https://stackoverflow.com/questions/3807231/how-can-i-test-if-i-can-write-to-a-filehandle
1124             ## -> https://stackoverflow.com/a/3807381/4814971
1125             sub _can_write_fh
1126             {
1127 0     0   0 my $self = shift( @_ );
1128 0         0 my $fh = shift( @_ );
1129 0         0 my $flags = fcntl( $fh, F_GETFL, 0 );
1130 0 0       0 if( ( $flags & O_ACCMODE ) & ( O_WRONLY|O_RDWR ) )
1131             {
1132 0         0 return(1);
1133             }
1134 0         0 return(0);
1135             }
1136              
1137             sub _set_get_meta_date
1138             {
1139 4     4   25 my $self = shift( @_ );
1140 4   50     30 my $field = shift( @_ ) || return( $self->error( "No field was provided to get its DateTime object equivalent." ) );
1141 4 50       34 if( @_ )
1142             {
1143 0         0 my $v = shift( @_ );
1144 0 0 0     0 if( ref( $v ) && $self->_is_a( $v => 'DateTime' ) )
1145             {
1146 0         0 my $strp = DateTime::Format::Strptime->new(
1147             pattern => '%F %H:%M%z',
1148             locale => 'en_GB',
1149             time_zone => ( HAS_LOCAL_TZ ? 'local' : 'UTC' ),
1150             );
1151 0         0 $v->set_formatter( $strp );
1152             }
1153 0         0 $self->meta( $field => $v );
1154 0         0 return( $v );
1155             }
1156             else
1157             {
1158 4         39 my $meta = $self->meta( $field );
1159 4 50 33     155 if( !defined( $meta ) || !length( $meta ) )
1160             {
1161 0         0 return;
1162             }
1163 4         94 return( $self->parse_date_to_object( $meta ) );
1164             }
1165             }
1166              
1167             sub _set_get_meta_value
1168             {
1169 21     21   63 my $self = shift( @_ );
1170 21   50     255 my $field = shift( @_ ) || return( $self->error( "No field was provided to get its DateTime object equivalent." ) );
1171 21 50       112 if( @_ )
1172             {
1173 0         0 my $v = shift( @_ );
1174 0         0 $self->meta( $field => $v );
1175             }
1176 21         79 return( $self->meta( $field ) );
1177             }
1178              
1179             # NOTE: Text::PO::HeaderValue class
1180             {
1181             package
1182             Text::PO::HeaderValue;
1183             BEGIN
1184             {
1185 4     4   36 use strict;
  4         9  
  4         99  
1186 4     4   23 use warnings;
  4         8  
  4         150  
1187 4     4   29 use parent qw( Module::Generic );
  4         7  
  4         39  
1188 4     4   334 use vars qw( $VERSION $QUOTE_REGEXP $TYPE_REGEXP $TOKEN_REGEXP $TEXT_REGEXP );
  4         7  
  4         354  
1189 4     4   812 our $VERSION = 'v0.1.0';
1190             use overload (
1191 4         46 '""' => 'as_string',
1192             fallback => 1,
1193 4     4   26 );
  4         14  
1194 4         23 our $QUOTE_REGEXP = qr/([\\"])/;
1195             #
1196             # RegExp to match type in RFC 7231 sec 3.1.1.1
1197             #
1198             # media-type = type "/" subtype
1199             # type = token
1200             # subtype = token
1201             #
1202 4         202 our $TYPE_REGEXP = qr/^[!#$%&'*+.^_`|~0-9A-Za-z-]+\/[!#$%&'*+.^_`|~0-9A-Za-z-]+$/;
1203 4         100 our $TOKEN_REGEXP = qr/^[!#$%&'*+.^_`|~0-9A-Za-z-]+$/;
1204 4         98 our $TEXT_REGEXP = qr/^[\u000b\u0020-\u007e\u0080-\u00ff]+$/;
1205             };
1206            
1207 4     4   25 use strict;
  4         8  
  4         83  
1208 4     4   21 use warnings;
  4         9  
  4         2157  
1209            
1210             sub init
1211             {
1212 2     2   227 my $self = shift( @_ );
1213 2         10 my $value = shift( @_ );
1214 2 50       14 return( $self->error( "No value provided." ) ) if( !length( $value ) );
1215 2         123 $self->{original} = '';
1216 2         19 $self->{value} = $value;
1217 2         27 $self->SUPER::init( @_ );
1218 2         182 $self->{params} = {};
1219 2         10 return( $self );
1220             }
1221            
1222             sub as_string
1223             {
1224 0     0   0 my $self = shift( @_ );
1225 0 0 0     0 if( !defined( $self->{original} ) || !length( $self->{original} ) )
1226             {
1227 0         0 my $string = '';
1228 0 0 0     0 if( defined( $self->{value} ) && length( $self->{value} ) )
1229             {
1230 0 0       0 if( $self->{value} !~ /^$TYPE_REGEXP$/ )
1231             {
1232 0         0 return( $self->error( "Invalid value \"$self->{value}\"" ) );
1233             }
1234 0         0 $string = $self->{value};
1235             }
1236              
1237             # Append parameters
1238 0 0 0     0 if( $self->{params} && ref( $self->{params} ) eq 'HASH' )
1239             {
1240 0         0 my $params = [ sort( keys( %{$self->{params}} ) ) ];
  0         0  
1241 0         0 for( my $i = 0; $i < scalar( @$params ); $i++ )
1242             {
1243 0 0       0 if( $params->[$i] !~ /^$TOKEN_REGEXP$/ )
1244             {
1245 0         0 return( $self->error( "Invalid parameter name: \"" . $params->[$i] . "\"" ) );
1246             }
1247 0 0       0 if( length( $string ) > 0 )
1248             {
1249 0         0 $string .= '; ';
1250             }
1251 0         0 $string .= $params->[$i] . '=' . $self->qstring( $self->{params}->{ $params->[$i] } );
1252             }
1253             }
1254 0         0 $self->{original} = $string;
1255             }
1256 0         0 return( $self->{original} );
1257             }
1258            
1259 0     0   0 sub original { return( shift->_set_get_scalar_as_object( 'original', @_ ) ); }
1260            
1261             sub param
1262             {
1263 2     2   15 my $self = shift( @_ );
1264 2   50     19 my $name = shift( @_ ) || return( $self->error( "No parameter name was provided." ) );
1265 2 50       16 if( @_ )
1266             {
1267 2         9 my $v = shift( @_ );
1268 2         18 $self->{params}->{ $name } = $v;
1269             }
1270 2         16 return( $self->{params}->{ $name } );
1271             }
1272            
1273             sub qstring
1274             {
1275 0     0     my $self = shift( @_ );
1276 0           my $str = shift( @_ );
1277              
1278             # no need to quote tokens
1279 0 0         if( $str =~ /^$TOKEN_REGEXP$/ )
1280             {
1281 0           return( $str );
1282             }
1283              
1284 0 0 0       if( length( $str ) > 0 && $str !~ /^$TEXT_REGEXP$/ )
1285             {
1286 0           return( $self->error( 'Invalid parameter value' ) );
1287             }
1288            
1289 0           $str =~ s/$QUOTE_REGEXP/\\$1/g;
1290 0           return( '"' . $str . '"' );
1291             }
1292            
1293 0     0     sub value { return( shift->_set_get_scalar_as_object( 'value', @_ ) ); }
1294             }
1295              
1296             1;
1297             # NOTE: POD
1298             __END__
1299              
1300             =head1 NAME
1301              
1302             Text::PO - Read and write PO files
1303              
1304             =head1 SYNOPSIS
1305              
1306             use Text::PO;
1307             my $po = Text::PO->new;
1308             $po->debug( 2 );
1309             $po->parse( $poFile ) || die( $po->error, "\n" );
1310             my $hash = $po->as_hash;
1311             my $json = $po->as_json;
1312             # Add data:
1313             my $e = $po->add_element(
1314             msgid => 'Hello!',
1315             msgstr => 'Salut !',
1316             );
1317             $po->remove_element( $e );
1318             $po->elements->foreach(sub
1319             {
1320             my $e = shift( @_ ); # $_ is also available
1321             if( $e->msgid eq $other->msgid )
1322             {
1323             # do something
1324             }
1325             });
1326            
1327             # Write in a PO format to STDOUT
1328             $po->dump;
1329             # or to a file handle
1330             $po->dump( $io );
1331             # Synchronise data
1332             $po->sync( '/some/where/com.example.api.po' );
1333             $po->sync( $file_handle );
1334             # or merge
1335             $po->merge( '/some/where/com.example.api.po' );
1336             $po->merge( $file_handle );
1337              
1338             =head1 VERSION
1339              
1340             v0.6.0
1341              
1342             =head1 DESCRIPTION
1343              
1344             This module parse GNU PO (portable object) and POT (portable object template) files, making it possible to edit the localised text and write it back to a po file.
1345              
1346             L<Text::PO::MO> reads and writes C<.mo> (machine object) binary files.
1347              
1348             Thus, with those modules, you do not need to install C<msgfmt>, C<msginit> of GNU. It is better if you have them though.
1349              
1350             Also, this distribution provides a way to export the C<po> files in json format to be used from within JavaScript and a JavaScript class to load and use those files is also provided along with some command line scripts. See the C<share> folder along with its own test units.
1351              
1352             Also, there is a script in C<scripts> that can be used to transcode C<.po> or C<mo> files into json format and vice versa.
1353              
1354             =head1 CONSTRUCTOR
1355              
1356             =head2 new
1357              
1358             Create a new Text::PO object acting as an accessor.
1359              
1360             One object should be created per po file, because it stores internally the po data for that file in the L<Text::PO> object instantiated.
1361              
1362             Returns the object.
1363              
1364             =head2 METHODS
1365              
1366             =head2 add_element
1367              
1368             Given either a L<Text::PO::Element> object, or an hash ref with keys like C<msgid> and C<msgstr>, or given a C<msgid> followed by an optional hash ref, L</add_element> will add this to the stack of elements.
1369              
1370             It returns the newly created element if it did not already exist, or the existing one found. Thus if you try to add an element data that already exists, this will prevent it and return the existing element object found.
1371              
1372             =head2 added
1373              
1374             Returns an array object (L<Module::Generic::Array>) of L<Text::PO::Element> objects added during synchronisation.
1375              
1376             =head2 as_json
1377              
1378             This takes an optional hash reference of option parameters and return a json formatted string.
1379              
1380             All options take a boolean value. Possible options are:
1381              
1382             =over 4
1383              
1384             =item * C<indent>
1385              
1386             If true, L<JSON> will indent the data.
1387              
1388             Default to false.
1389              
1390             =item * C<pretty>
1391              
1392             If true, this will return a human-readable json data.
1393              
1394             =item * C<sort>
1395              
1396             If true, this will instruct L<JSON> to sort the keys. This makes it slower to generate.
1397              
1398             It defaults to false, which will use a pseudo random order set by perl.
1399              
1400             =item * C<utf8>
1401              
1402             If true, L<JSON> will utf8 encode the data.
1403              
1404             =back
1405              
1406             =head2 as_hash
1407              
1408             Return the data parsed as an hash reference.
1409              
1410             =head2 as_json
1411              
1412             Return the PO data parsed as json data.
1413              
1414             =head2 charset
1415              
1416             Sets or gets the character encoding for the po data. This will affect the C<charset> parameter in C<Content-Type> meta information.
1417              
1418             =head2 content_encoding
1419              
1420             Sets or gets the meta field value for C<Content-Encoding>
1421              
1422             =head2 content_type
1423              
1424             Sets or gets the meta field value for C<Content-Type>
1425              
1426             =head2 current_lang
1427              
1428             Returns the current language environment variable set, trying C<LANGUAGE> and C<LANG>
1429              
1430             =head2 decode
1431              
1432             Given a string, this will decode it using the character set specified with L</encoding>
1433              
1434             =head2 domain
1435              
1436             Sets or gets the domain (or namespace) for this PO. Something like C<com.example.api>
1437              
1438             =head2 dump
1439              
1440             Given an optional filehandle, or STDOUT by default, it will print to that filehandle in a format suitable to the po file.
1441              
1442             Thus, one could create a perl script, read a po file, then redirect the output of the dump back to another po file like
1443              
1444             ./po_script.pl en_GB.po > new_en_GB.po
1445              
1446             It returns the L<Text::PO> object used.
1447              
1448             =head2 elements
1449              
1450             Returns the array reference of all the L<Text::PO::Element> objects
1451              
1452             =head2 encoding
1453              
1454             Sets or gets the character set encoding for the GNU PO file. Typically this should be C<utf-8>
1455              
1456             =head2 exists
1457              
1458             Given a L<Text::PO::Element> object, it will check if this object exists in its current stack. To achieve this, it will check if both the C<msgid> and the C<msgstr> exists and match. If you only want to check if the C<msgid> exists, use the C<msgid_only> option as explained below.
1459              
1460             It takes an optional hash or hash reference of options as follows:
1461              
1462             =over 4
1463              
1464             =item * C<msgid_only>
1465              
1466             Boolean. If true, this will check only if the C<msgid> already exists, and not the corresponding C<msgstr>
1467              
1468             =back
1469              
1470             It returns true of false accordingly.
1471              
1472             =head2 hash
1473              
1474             Returns the data of the po file as an hash reference with each key representing a string and its value the localised version.
1475              
1476             =head2 header
1477              
1478             Access the headers data for this po file. The data is an array reference.
1479              
1480             =head2 language
1481              
1482             Sets or gets the meta field value for C<Language>
1483              
1484             =head2 language_team
1485              
1486             Sets or gets the meta field value for C<Language-Team>
1487              
1488             =head2 last_translator
1489              
1490             Sets or gets the meta field value for C<Last-Translator>
1491              
1492             =head2 merge
1493              
1494             This takes the same parameters as L</sync> and will merge the current data with the target data and return the newly created L<Text::PO> object
1495              
1496             =head2 meta
1497              
1498             This sets or return the given meta information. The meta field name provided is case insensitive and you can replace dashes (C<->) with underscore (<_>)
1499              
1500             $po->meta( 'Project-Id-Version' => 'MyProject 1.0' );
1501             # or this will also work
1502             $po->meta( project_id_version => 'MyProject 1.0' );
1503              
1504             It can take a hash ref, a hash, or a single element. If a single element is provided, it return its corresponding value.
1505              
1506             This returns its internal hash of meta information.
1507              
1508             =head2 meta_keys
1509              
1510             This is an hash reference of meta information.
1511              
1512             =head2 mime_version
1513              
1514             Sets or gets the meta field value for C<MIME-Version>
1515              
1516             =head2 new_element
1517              
1518             Provided with an hash or hash reference of property-value pairs, and this will pass those information to L<Text::PO::Element> and return the new object.
1519              
1520             =head2 normalise_meta
1521              
1522             Given a meta field, this will return a normalised version of it, ie a field name with the right case and dash instead of underscore characters.
1523              
1524             =head2 parse
1525              
1526             Given a filepath to a po file or a file handle, this will parse the po file and return a new L<Text::PO> object.
1527              
1528             For each new entry that L</parse> find, it creates a L<Text::PO::Element> object.
1529              
1530             The list of all elements found can then be accessed using L</elements>
1531              
1532             It returns the current L<Text::PO> object
1533              
1534             =head2 parse_date_to_object
1535              
1536             Provided with a date string and this returns a L<DateTime> object
1537              
1538             =head2 parse_header_value
1539              
1540             Takes a header value such as C<text/plain; charset="utf-8"> and this returns a C<Text::PO::HeaderValue> object
1541              
1542             =head2 parse2hash
1543              
1544             Whether the pod file is stored as standard GNU po data or as json data, this method will read its data and return an hash reference of it.
1545              
1546             =head2 parse2object
1547              
1548             Takes a file path, parse the po file and loads its data onto the current object. It returns the current object.
1549              
1550             =head2 plural
1551              
1552             Sets or gets the plurality definition for this domain and locale used in the current object.
1553              
1554             If set, this will expect 2 parameters: 1) an integer representing the possible plurality for the given locale and 2) the expression that will be evaluated to assess which plural form to use.
1555              
1556             It returns an array reference representing those 2 values.
1557              
1558             =head2 plural_forms
1559              
1560             Sets or gets the meta field value for C<Plural-Forms>
1561              
1562             =head2 po_revision_date
1563              
1564             Sets or gets the meta field value for C<PO-Revision-Date>
1565              
1566             =head2 pot_creation_date
1567              
1568             Sets or gets the meta field value for C<POT-Creation-Date>
1569              
1570             =head2 project_id_version
1571              
1572             Sets or gets the meta field value for C<Project-Id-Version>
1573              
1574             =head2 quote
1575              
1576             Given a string, it will escape carriage return, double quote and return it,
1577              
1578             =head2 remove_duplicates
1579              
1580             Takes a boolean value to enable or disable the removal of duplicates in the po file.
1581              
1582             =head2 remove_element
1583              
1584             Given a L<Text::PO::Element> and this will remove it from the object elements list.
1585              
1586             If the value provided is not an L<Text::PO::Element> object it will return an error.
1587              
1588             It returns a true value representing the number of elements removed or 0 if none could be found.
1589              
1590             =head2 removed
1591              
1592             Sets or gets this boolean value.
1593              
1594             =head2 report_bugs_to
1595              
1596             Sets or gets the meta field value for C<Report-Msgid-Bugs-To>
1597              
1598             =head2 quote
1599              
1600             Takes a string and escape the characters that needs to be and returns it.
1601              
1602             =head2 remove_duplicates
1603              
1604             Takes a boolean value and if true, this will remove duplicate msgid.
1605              
1606             =head2 removed
1607              
1608             Returns an array object (L<Module::Generic::Array>) of L<Text::PO::Element> removed during synchronisation.
1609              
1610             =head2 source
1611              
1612             Sets or gets an hash reference of parameters providing information about the source of the data.
1613              
1614             It could have an attribute C<handle> with a glob as value or an attribute C<file> with a filepath as value.
1615              
1616             =head2 sync
1617              
1618             $po->sync( '/some/where/com.example.api.po' );
1619             # or
1620             $po->sync({ file => '/some/where/com.example.api.po' });
1621             # or
1622             $po->sync({ handle => $file_handle });
1623             # or, if source of data has been set previously by parse()
1624             $po->parse( '/some/where/com.example.api.po' );
1625             # Do some change to the data, then:
1626             $po->sync;
1627              
1628             Given a file or a file handle, it will read the po file, and our current object will synchronise against it.
1629              
1630             It takes an hash or hash reference passed as argument, as optional parameters with the following properties:
1631              
1632             =over 4
1633              
1634             =item I<file>
1635              
1636             File path
1637              
1638             =item I<handle>
1639              
1640             Opened file handle
1641              
1642             =back
1643              
1644             This means that our object is the source and the file or filehandle representing the target po file is the recipient of the synchronisation.
1645              
1646             This method will return an error a file is provided, already exists, but is either a symbolic link or not a regular file (C<-f> test), or a file handle is provided, but not currently opened.
1647              
1648             If a file path is provided, and the file does not yet exist, it will attempt to create it or return an error if it cannot. In this case, it will use L</dump> to write all its data to file.
1649              
1650             If the target file was created, it will return the current object, otherwise it returns the newly created L<Text::PO> representing the data synchronised.
1651              
1652             =head2 sync_fh
1653              
1654             Takes a file handle as its unique argument and synchronise the object data with the file handle. This means, the file handle provided must be opened in both read and write mode.
1655              
1656             What it does is that, after creating a new L<Text::PO> object, it will first call L</parse> on the file handle to load its data, and then add all of the current object data to the newly created object, and finally dump all back to the file handle using L</dump>
1657              
1658             It will set two array of data: one for the elements that did not exist in the recipient data and thus were added and one for those elements in the target data that did not exist in the source object and thus were removed.
1659              
1660             If the option I<append> is specified, however, it will not remove those elements in the target that doe not exist in the source one. You can get the same result by calling the method L</merge> instead of L</sync>
1661              
1662             You can get the data of each of those 2 arrays by calling the methods L</added> and L</removed> respectively.
1663              
1664             It returns the newly created L<Text::PO> object containing the synchronised data.
1665              
1666             =head2 unquote
1667              
1668             Takes a string, unescape it and returns it.
1669              
1670             =head2 use_json
1671              
1672             Takes a boolean value and if true, this will save the data as json instead of regular po format.
1673              
1674             Saving data as json makes it quicker to load, but also enable the data to be used by JavaScript.
1675              
1676             =head1 PRIVATE METHODS
1677              
1678             =head2 _can_write_fh
1679              
1680             Given a filehandle, returns true if it can be written to it or false otherwise.
1681              
1682             =head2 _set_get_meta_date
1683              
1684             Takes a meta field name for a date-type field and sets its value, if one is provided, or returns a L<DateTime> object.
1685              
1686             If a value is provided, even a string, it will be converted to a L<DateTime> object and a L<DateTime::Format::Strptime> will be attached to it as a formatter so the stringification of the object produces a date compliant with PO format.
1687              
1688             =head2 _set_get_meta_value
1689              
1690             Takes a meta field name and sets or gets its value.
1691              
1692             =head1 AUTHOR
1693              
1694             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
1695              
1696             =head1 SEE ALSO
1697              
1698             L<Text::PO::Element>, L<Text::PO::MO>, L<Text::PO::Gettext>
1699              
1700             L<https://www.gnu.org/software/gettext/manual/html_node/PO-Files.html>,
1701              
1702             L<https://en.wikipedia.org/wiki/Gettext>
1703              
1704             L<GNU documentation on header format|https://www.gnu.org/software/gettext/manual/html_node/Header-Entry.html>
1705              
1706             =head1 COPYRIGHT & LICENSE
1707              
1708             Copyright (c) 2020-2021 DEGUEST Pte. Ltd.
1709              
1710             You can use, copy, modify and redistribute this package and associated files under the same terms as Perl itself.
1711              
1712             =cut