File Coverage

lib/Text/PO/MO.pm
Criterion Covered Total %
statement 243 278 87.4
branch 62 114 54.3
condition 32 85 37.6
subroutine 21 35 60.0
pod 15 23 65.2
total 373 535 69.7


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## PO Files Manipulation - ~/lib/Text/PO/MO.pm
3             ## Version v0.4.0
4             ## Copyright(c) 2023 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2021/06/25
7             ## Modified 2025/12/02
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::MO;
14             BEGIN
15             {
16 2     2   569929 use strict;
  2         5  
  2         89  
17 2     2   11 use warnings;
  2         5  
  2         149  
18 2     2   936 warnings::register_categories( 'Text::PO' );
19 2     2   12 use parent qw( Module::Generic );
  2         4  
  2         13  
20 2     2   154 use vars qw( $VERSION @META $DEF_META );
  2         21  
  2         135  
21 2     2   12 use Encode ();
  2         4  
  2         39  
22 2     2   793 use Text::PO;
  2         8  
  2         19  
23 2         64 our $VERSION = 'v0.4.0';
24             };
25              
26 2     2   17 use strict;
  2         4  
  2         101  
27 2     2   12 use warnings;
  2         4  
  2         10337  
28              
29             our @META = @Text::PO::META;
30             our $DEF_META = $Text::PO::DEF_META;
31              
32             sub init
33             {
34 3     3 1 434187 my $self = shift( @_ );
35 3         154 $self->{auto_decode} = 1;
36 3         16 $self->{default_encoding} = 'utf-8';
37 3         14 $self->{domain} = undef;
38 3         9 $self->{encoding} = undef;
39 3         10 $self->{file} = undef;
40 3         13 $self->{use_cache} = 1;
41 3         12 $self->{_init_strict_use_sub} = 1;
42 3         29 $self->SUPER::init( @_ );
43 3         4094 $self->{revision} = 0;
44 3         25 $self->{magic} = '0x950412de';
45 3         26 $self->{_last_modified} = '';
46 3         28 return( $self );
47             }
48              
49             sub as_object
50             {
51 1     1 1 1214 my $self = shift( @_ );
52             # Pass through any argument we received over to read()
53 1 50       12 my( $ref, $order ) = $self->read( ( @_ ? @_ : () ) );
54 1 50       12808 return( $self->pass_error ) if( !defined( $ref ) );
55             # Get the raw meta element
56 1   50     11 my $raw = $ref->{ '' } // '';
57             # Split on actual \n, filter non-empty
58 1         18 my $arr = [grep{ length( $_ ) } split( /\n/, $raw )];
  11         29  
59 1         16 my $po = Text::PO->new( debug => $self->debug, encoding => $self->encoding, domain => $self->domain );
60              
61 1         10 my $meta = {};
62 1         3 my $meta_keys = [];
63 1         3 foreach my $s ( @$arr )
64             {
65 11         21 chomp( $s );
66 11         43 $s =~ s/^[[:blank:]]*"//; # Strip leading spaces and optional "
67 11         77 $s =~ s/"[[:blank:]]*$//; # Strip trailing " and spaces
68 11 100       41 if( $s =~ /^([^\x00-\x1f\x80-\xff :=]+):[[:blank:]]*(.*?)$/ )
69             {
70 1         14 my( $k, $v ) = ( lc( $1 ), $2 );
71 1         5 $meta->{ $k } = $v;
72 1         3 push( @$meta_keys, $k );
73             }
74             }
75              
76 1         17 my $rv = $po->meta( $meta );
77 1         221916 $po->meta_keys( $meta_keys );
78 1         745 my $e = $po->new_element({
79             is_meta => 1,
80             msgid => '',
81             msgstr => $arr,
82             });
83 1         3 push( @{$po->{elements}}, $e );
  1         4  
84              
85             # Process order to handle contexts and plurals (from previous fix—keep if you applied)
86 1         2 foreach my $k ( @$order )
87             {
88 9 100       53 next if( !length( $k ) ); # Skip meta
89 8         8 my $orig = $k;
90 8         9 my $ctx = '';
91 8         11 my $msgid_plural = '';
92 8 50       21 if( $orig =~ /^(.*?)\x04(.*)$/s )
93             {
94 0         0 $ctx = $1;
95 0         0 $orig = $2;
96             }
97 8         21 my @msgid_parts = split( /\x00/, $orig );
98 8         9 my $msgid = shift( @msgid_parts );
99 8 100       16 $msgid_plural = shift( @msgid_parts ) if( @msgid_parts );
100              
101 8         21 my $v = $ref->{ $k };
102 8         25 my @msgstr_parts = split( /\x00/, $v );
103              
104 8         40 my $e = $po->new_element({
105             msgid => $msgid,
106             });
107 8 50       34 $e->context( $ctx ) if( length( $ctx ) );
108 8 100       15 if( length( $msgid_plural ) )
109             {
110 1         12 $e->msgid_plural( $msgid_plural );
111 1         148 $e->plural(1);
112 1         678 for( my $i = 0; $i < @msgstr_parts; $i++ )
113             {
114 2         11 $e->msgstr( $i, $msgstr_parts[$i] );
115             }
116             }
117             else
118             {
119 7         46 $e->msgstr( $msgstr_parts[0] );
120             }
121 8         10 push( @{$po->{elements}}, $e );
  8         34  
122             }
123 1         12 return( $po );
124             }
125              
126 1     1 1 31 sub auto_decode { return( shift->_set_get_boolean( 'auto_decode', @_ ) ); }
127              
128             sub decode
129             {
130 2     2 1 6 my $self = shift( @_ );
131 2         3 my $hash = shift( @_ );
132 2   66     43 my $enc = shift( @_ ) || $self->encoding;
133 2 50       933 return( $self->error( "Data provided is not an hash reference." ) ) if( ref( $hash ) ne 'HASH' );
134 2 50       7 return( $self->error( "No character encoding was provided to decode the mo file data." ) ) if( !CORE::length( $enc ) );
135             # try-catch
136 2         3 local $@;
137             eval
138 2         4 {
139 2         26 foreach my $k ( sort( keys( %$hash ) ) )
140             {
141 11         21 my $v = $hash->{ $k };
142 11         51 my $k2 = Encode::decode( $enc, $k, Encode::FB_CROAK );
143 11         746 my $v2 = Encode::decode( $enc, $v, Encode::FB_CROAK );
144 10 50       345 CORE::delete( $hash->{ $k } ) if( CORE::length( $k ) );
145 10         40 $hash->{ $k2 } = $v2;
146             }
147             };
148 2 100       52 if( $@ )
149             {
150 1         16 return( $self->error( "An error occurred while trying to decode mo data using character encoding \"$enc\": $@" ) );
151             }
152 1         6 return( $hash );
153             }
154              
155 0     0 1 0 sub default_encoding { return( shift->_set_get_scalar( 'default_encoding', @_ ) ); }
156              
157 3     3 1 468318 sub domain { return( shift->_set_get_scalar( 'domain', @_ ) ); }
158              
159             sub encode
160             {
161 9     9 1 18 my $self = shift( @_ );
162 9         13 my $hash = shift( @_ );
163 9   33     28 my $enc = shift( @_ ) || $self->encoding;
164 9 50       27 return( $self->error( "Data provided is not an hash reference." ) ) if( ref( $hash ) ne 'HASH' );
165 9 50       27 return( $self->error( "No character encoding was provided to encode data." ) ) if( !CORE::length( $enc ) );
166             # try-catch
167 9         14 local $@;
168             eval
169 9         19 {
170 9         31 foreach my $k ( keys( %$hash ) )
171             {
172 18         35 my $v = $hash->{ $k };
173 18 50       64 if( $self->_is_array( $hash->{ $k } ) )
    50          
174             {
175 0         0 for( my $i = 0; $i < scalar( @{$hash->{ $k }} ); $i++ )
  0         0  
176             {
177 0 0       0 $hash->{ $k }->[$i] = Encode::encode( $enc, $hash->{ $k }->[$i], Encode::FB_CROAK ) if( Encode::is_utf8( $hash->{ $k }->[$i] ) );
178             }
179             }
180             elsif( !ref( $hash->{ $k } ) )
181             {
182 18 100       305 my $v2 = Encode::is_utf8( $v ) ? Encode::encode( $enc, $v, Encode::FB_CROAK ) : $v;
183 18         459 $hash->{ $k } = $v2;
184             }
185             }
186             };
187 9 50       22 if( $@ )
188             {
189 0         0 return( $self->error( "An error occurred while trying to encode data using character encoding \"$enc\": $@" ) );
190             }
191 9         35 return( $hash );
192             }
193              
194 6     6 1 1322 sub encoding { return( shift->_set_get_scalar( 'encoding', @_ ) ); }
195              
196 4     4 1 728 sub file { return( shift->_set_get_file( 'file', @_ ) ); }
197              
198             sub read
199             {
200 1     1 1 3 my $self = shift( @_ );
201 1         12 my $opts = $self->_get_args_as_hash( @_ );
202 1   33     22 my $file = $opts->{file} || $self->file;
203             # Caching mechanism
204 1 0 33     1563 if( !$self->{use_cache} &&
      33        
      33        
      0        
      0        
205             !$opts->{no_cache} &&
206             -e( $file ) &&
207             ref( $self->{_cache} ) eq 'ARRAY' &&
208             $self->{_last_modified} &&
209             [CORE::stat( $file )]->[9] <= $self->{_last_modified} )
210             {
211 0 0       0 return( wantarray() ? @{$self->{_cache}} : $self->{_cache}->[0] );
  0         0  
212             }
213 1 50       7 return( $self->error( "mo file \"$file\" does not exist." ) ) if( !-e( $file ) );
214 1 50       100 return( $self->error( "mo file \"$file\" is not readable." ) ) if( !-r( $file ) );
215 1   50     54 my $f = $self->new_file( $file ) ||
216             return( $self->error( "Unable to open mo file \"$file\": ", $self->error ) );
217 1   50     216407 my $io = $f->open( '<' ) || return( $self->pass_error( $f->error ) );
218 1         6771 $io->binmode;
219 1         347 my $data;
220 1         19 $io->read( $data, -s( $file ) );
221 1         572 $io->close;
222 1         2571 my $byte_order = substr( $data, 0, 4 );
223 1         2 my $tmpl;
224             # Little endian
225 1 50       25 if( $byte_order eq "\xde\x12\x04\x95" )
    50          
226             {
227 0         0 $tmpl = "V";
228             }
229             # Big endian
230             elsif( $byte_order eq "\x95\x04\x12\xde" )
231             {
232 1         4 $tmpl = "N";
233             }
234             else
235             {
236 0         0 return( $self->error( "Provided file \"$file\" is not a valid mo file." ) );
237             }
238             # Check the MO format revision number
239 1         11 my $rev_num = unpack( $tmpl, substr( $data, 4, 4 ) );
240             # There is only one revision now: revision 0.
241 1 50       12 return if( $rev_num > 0 );
242 1         4 $self->{revision} = $rev_num;
243              
244             # Total messages
245 1         4 my $total = unpack( $tmpl, substr( $data, 8, 4 ) );
246             # Offset to the beginning of the original messages
247 1         3 my $off_msgid = unpack( $tmpl, substr( $data, 12, 4 ) );
248             # Offset to the beginning of the translated messages
249 1         7 my $off_msgstr = unpack( $tmpl, substr( $data, 16, 4 ) );
250 1         3 my $hash = {};
251 1         3 my $order = [];
252 1         11 for( my $i = 0; $i < $total; $i++ )
253             {
254 9         14 my( $len, $off, $msgid, $msgstr );
255             # The first word is the length of the message
256 9         17 $len = unpack( $tmpl, substr( $data, $off_msgid + $i * 8, 4 ) );
257             # The second word is the offset of the message
258 9         24 $off = unpack( $tmpl, substr( $data, $off_msgid + $i * 8 + 4, 4 ) );
259             # Original message
260 9         17 $msgid = substr( $data, $off, $len );
261            
262             # The first word is the length of the message
263 9         13 $len = unpack( $tmpl, substr( $data, $off_msgstr + $i * 8, 4 ) );
264             # The second word is the offset of the message
265 9         18 $off = unpack( $tmpl, substr( $data, $off_msgstr + $i * 8 + 4, 4 ) );
266             # Translated message
267 9         31 $msgstr = substr( $data, $off, $len );
268            
269 9         61 $hash->{ $msgid } = $msgstr;
270 9         31 push( @$order, $msgid );
271             }
272            
273 1 50 33     24 if( $self->auto_decode || $opts->{auto_decode} )
274             {
275 1 50       1098 unless( my $enc = $self->encoding )
276             {
277             # Find the encoding of that MO file
278 1 50 33     1008 if( defined( $hash->{ '' } ) &&
279             $hash->{ '' } =~ /Content-Type:[[:blank:]\h]*text\/plain;[[:blank:]\h]*charset[[:blank:]\h]*=[[:blank:]\h]*(?<quote>["'])?(?<encoding>[\w\-]+)\g{quote}?/is )
280             {
281 1         19 $enc = $+{encoding};
282 1 50       5 $self->encoding( $enc ) || return( $self->pass_error );
283             }
284             # Default to US-ASCII
285             else
286             {
287 0   0     0 $enc = $self->default_encoding || $opts->{default_encoding};
288             }
289 1 50       1131 $self->decode( $hash, $enc ) || return( $self->pass_error );
290             }
291 1         5 $self->decode( $hash );
292             }
293 1         27696 $self->{_last_modified} = [CORE::stat( $file )]->[9];
294 1         99 $self->{_cache} = [ $hash, $order ];
295 1 50       24 return( wantarray() ? ( $hash, $order ) : $hash );
296             }
297              
298             sub reset
299             {
300 0     0 1 0 my $self = shift( @_ );
301 0         0 $self->{_cache} = [];
302 0         0 $self->{_last_modified} = '';
303 0         0 return( $self );
304             }
305              
306 0     0 1 0 sub revision { return( shift->_set_get_scalar( 'revision', @_ ) ); }
307              
308 0     0 1 0 sub use_cache { return( shift->_set_get_boolean( 'use_cache', @_ ) ); }
309              
310             sub write
311             {
312 1     1 1 33 my $self = shift( @_ );
313 1         3 my $po = shift( @_ );
314 1         21 my $opts = $self->_get_args_as_hash( @_ );
315              
316 1 50       11 if( !defined( $po ) )
317             {
318 0         0 return( $self->error( "I was expecting a Text::PO object, and got nothing." ) );
319             }
320              
321 1 50 33     14 if( !$self->_is_object( $po ) || !$po->isa( 'Text::PO' ) )
322             {
323 0         0 return( $self->error( "I was expecting a Text::PO object, and got an object of class \"" . ref( $po ) . "\" instead." ) );
324             }
325              
326 1   50     40 $opts->{encoding} //= '';
327 1   50     6 my $enc = $opts->{encoding} || $self->encoding || $self->default_encoding || 'utf-8';
328              
329             # Build the hash of entries to write to the mo file.
330             # Keys are msgid (possibly including context and plural markers),
331             # values are msgstr (for plurals, concatenated with NUL separators).
332 1         891 my %entries;
333             my @keys;
334              
335             # Header / meta entry (msgid == "")
336 1         21 my $meta_keys = $po->meta_keys;
337 1 50 33     824 if( $meta_keys && !$meta_keys->is_empty )
338             {
339 1         29 my $header = '';
340              
341 1         8 foreach my $k ( @$meta_keys )
342             {
343 1         15 my $v = $po->meta( $k );
344 1 50 33     57 next if( !defined( $v ) || !length( $v ) );
345             # "Key: Value\n" – this is what gettext stores in the header string
346 1         5 $header .= sprintf( "%s: %s\n", $k, $v );
347             }
348              
349 1 50       4 if( length( $header ) )
350             {
351 1   50     19 my $h = $self->encode( { msgid => '', msgstr => $header } => $enc ) || return( $self->pass_error );
352              
353 1         9 $entries{ $h->{msgid} } = $h->{msgstr};
354             # usually the empty string
355 1         8 push( @keys, $h->{msgid} );
356             }
357             }
358              
359             # Regular entries
360 1         15 my $elems = $po->elements;
361              
362 1 50 33     924 if( $elems && ref( $elems ) )
363             {
364 1         5 foreach my $e ( @$elems )
365             {
366 9 50       988 next if( !$e );
367             # Header already handled via meta above
368 9 100 66     94 next if( $e->can( 'is_meta' ) && $e->is_meta );
369             # $include markers themselves should not become entries
370 8 50 33     7029 next if( $e->can( 'is_include' ) && $e->is_include );
371              
372 8         6963 my $msgid = $e->msgid_as_text;
373 8 50       28 next if( !defined( $msgid ) );
374              
375 8 50 50     56 my $ctx = $e->can( 'context' ) ? ( $e->context || '' ) : '';
376 8         7064 my $msgid_plural = $e->msgid_plural_as_string;
377              
378             # Build the msgid key as used inside the mo file:
379             # [ctx + EOT] + msgid [+ NUL + msgid_plural]
380 8         14 my $key = $msgid;
381 8 100 66     27 if( defined( $msgid_plural ) && length( $msgid_plural ) )
382             {
383             # singular and plural msgid separated by NUL
384 1         5 $key = join( null(), $msgid, $msgid_plural );
385             }
386              
387 8 50 33     39 if( defined( $ctx ) && length( $ctx ) )
388             {
389             # context is prefixed and separated by EOT (0x04)
390 0         0 $key = join( eot(), $ctx, $key );
391             }
392              
393             # Build msgstr (or msgstr[0]..[n] for plural forms)
394 8         11 my $val;
395 8 100       27 if( $e->plural )
396             {
397 1   50     956 my $multi = $e->msgstr // '';
398 1         3 my @parts;
399              
400             # $multi is an arrayref; each element is either a string
401             # or an arrayref of continuation lines
402 1 50       5 if( ref( $multi ) eq 'ARRAY' )
403             {
404 1         5 foreach my $variant ( @$multi )
405             {
406 2         13 my $s = '';
407 2 50       13 if( ref( $variant ) eq 'ARRAY' )
408             {
409             # Multi-line plural - concatenate lines, no extra NUL
410 2         8 $s = join( '', @$variant );
411             }
412             else
413             {
414 0 0       0 $s = defined( $variant ) ? $variant : '';
415             }
416 2         9 push( @parts, $s );
417             }
418             }
419             # Plural forms are separated by a single NUL
420 1         3 $val = join( null(), @parts );
421             }
422             else
423             {
424 7         6282 my $m = $e->msgstr;
425 7 50       25 if( ref( $m ) eq 'ARRAY' )
426             {
427             # Multi-line singular - concatenate lines, no extra NUL
428 0         0 $val = join( '', @$m );
429             }
430             else
431             {
432 7 50       19 $val = defined( $m ) ? $m : '';
433             }
434             }
435              
436 8   50     54 my $h = $self->encode( { msgid => $key, msgstr => $val } => $enc ) || return( $self->pass_error );
437             # Later entries override earlier ones for the same msgid, like msgfmt.
438 8         59 $entries{ $h->{msgid} } = $h->{msgstr};
439             }
440              
441             # Deterministic order:
442             # - header first (if present, already in @keys),
443             # - then all other keys sorted lexicographically (like msgfmt)
444             @keys = do
445 1         2 {
446 1         2 my %seen;
447 1         9 grep{ !$seen{ $_ }++ } @keys, sort( keys( %entries ) );
  10         48  
448             };
449             }
450              
451             # Serialise to the mo format.
452 1         4 my $cnt = scalar( @keys );
453 1         3 my $mem = 28 + ( $cnt * 16 );
454 1         11 my $l10n = [map( $entries{ $_ }, @keys )];
455              
456 1   33     21 my $file = $opts->{file} || $self->file;
457 1 50 33     1045 if( !defined( $file ) || !length( "$file" ) )
458             {
459 0         0 return( $self->error( "No file has been set to write mo data to." ) );
460             }
461              
462 1   50     68 my $f = $self->new_file( $file ) || return( $self->pass_error );
463 1   50     149298 my $fh = $f->open( '>', { binmode => 'raw', autoflush => 1 } ) ||
464             return( $self->pass_error( $f->error ) );
465              
466             # Magic (big-endian), revision, number of strings,
467             # offset of original table, offset of translation table,
468             # hash size and hash offset (unused).
469 1 50       5560 $fh->print(
470             pack( "N", 0x950412de ), # magic
471             pack( "N", 0 ), # revision
472             pack( "N", $cnt ), # number of strings
473             pack( "N", 28 ), # offset of original strings index
474             pack( "N", 28 + $cnt * 8 ), # offset of translated strings index
475             pack( "N", 0 ), # hash table size (unused)
476             pack( "N", 0 ), # hash table offset (unused)
477             ) || return( $self->error( "Unable to write mo header to \"$f\": $!" ) );
478              
479             # Original strings index
480 1         376 my $cursor = $mem;
481              
482 1         9 foreach my $k ( @keys )
483             {
484 9         14 my $len = length( $k );
485 9 50       56 $fh->print( pack( "N", $len ), pack( "N", $cursor ) ) ||
486             return( $self->error( "Unable to write original index for msgid \"$k\" to \"$f\": $!" ) );
487 9         1924 $cursor += $len + 1; # account for terminating NUL
488             }
489              
490             # Translated strings index
491 1         5 foreach my $v ( @{$l10n} )
  1         4  
492             {
493 9         24 my $len = length( $v );
494 9 50       65 $fh->print( pack( "N", $len ), pack( "N", $cursor ) ) ||
495             return( $self->error( "Unable to write translated index to \"$f\": $!" ) );
496 9         2234 $cursor += $len + 1; # account for terminating NUL
497             }
498              
499             # Original strings
500 1         11 foreach my $k ( @keys )
501             {
502 9 50       1808 $fh->print( $k, "\0" ) ||
503             return( $self->error( "Unable to write original string for msgid \"$k\" to \"$f\": $!" ) );
504             }
505              
506             # Translated strings
507 1         179 foreach my $v ( @{$l10n} )
  1         5  
508             {
509 9 50       1749 $fh->print( $v, "\0" ) ||
510             return( $self->error( "Unable to write translated string to \"$f\": $!" ) );
511             }
512              
513 1         337 $fh->close;
514             # We could do this, but it would return a Module::Generic::DateTime object, and we just need a simple unix timestamp.
515             # $self->{_last_modified} = $f->last_modified;
516 1         2300 $self->{_last_modified} = [CORE::stat( "$f" )]->[9];
517 1         78 $self->{_cache} = [];
518 1         20 return( $self );
519             }
520              
521             # NOTE: helper functions
522             # Credits to Ryan Niebur
523             sub character
524             {
525 0     0 1 0 return( map{ pack( "N*", $_ ) } @_ );
  0         0  
526             }
527              
528             sub eot
529             {
530 0     0 0 0 return( chr(4) );
531             }
532              
533             sub from_character
534             {
535 0     0 0 0 return( character( _from_character( @_ ) ) );
536             }
537              
538             sub from_hex
539             {
540 0     0 0 0 return( character( _from_hex( @_ ) ) );
541             }
542              
543             sub from_string
544             {
545 0     0 0 0 return( join_string( from_character( _from_string( @_ ) ) ) );
546             }
547              
548             sub join_string
549             {
550 0     0 0 0 return( join( '', @_ ) );
551             }
552              
553             sub null
554             {
555 2     2 0 10 return( null_terminate( '' ) );
556             }
557              
558             sub null_terminate
559             {
560 2     2 0 17 return( pack( "Z*", shift( @_ ) ) );
561             }
562              
563             sub number_to_s
564             {
565 0     0 0   return( sprintf( "%d", shift( @_ ) ) );
566             }
567              
568             sub _from_character
569             {
570 0     0     return( map( ord( $_ ), @_ ) );
571             }
572              
573             sub _from_hex
574             {
575 0     0     return( map( hex( $_ ), @_ ) );
576             }
577              
578             sub _from_string
579             {
580 0     0     return( split( //, join( '', @_ ) ) );
581             }
582              
583             1;
584             # NOTE: POD
585             __END__
586              
587             =encoding utf-8
588              
589             =head1 NAME
590              
591             Text::PO::MO - Read and write GNU gettext C<.mo> (Machine Object) files
592              
593             =head1 SYNOPSIS
594              
595             use Text::PO::MO;
596             my $mo = Text::PO::MO->new(
597             file => '/home/joe/locale/ja_JP/LC_MESSAGES/com.example.mo',
598             auto_decode => 1,
599             encoding => 'utf-8',
600             default_encoding => 'utf-8',
601             );
602             my $hash = $mo->read;
603             my $hash = $mo->read(
604             file => '/home/joe/locale/ja_JP/LC_MESSAGES/com.example.api.mo',
605             no_cache => 1,
606             auto_decode => 1,
607             default_encoding => 'utf8',
608             );
609              
610             my $po = $mo->as_object;
611             # Using the same possible options as read()
612             my $po = $mo->as_object(
613             file => '/home/joe/locale/ja_JP/LC_MESSAGES/com.example.api.mo',
614             no_cache => 1,
615             auto_decode => 1,
616             default_encoding => 'utf8',
617             );
618              
619             # Writing a .mo file from a Text::PO object
620             my $po = Text::PO->new->parse( 'messages.po' );
621             $mo->write( $po, {
622             file => 'messages.mo', # or, if not provided, use initial one set in the object.
623             encoding => 'utf8',
624             }) || die( $mo->error );
625              
626             $mo->auto_decode(1);
627             $mo->default_encoding( 'utf8' );
628             $mo->domain( 'com.example.api' );
629             $mo->encoding( 'utf8' );
630             $mo->file( '/some/where/locale/en_US/LC_MESSAGES/com.example.api.mo' );
631             $mo->revision( '0.1' );
632             $mo->use_cache(1);
633              
634             $mo->decode( $hash_ref ); # use previously declared encoding
635             $mo->decode( $hash_ref => 'utf8' );
636             $mo->encode( $hash_ref ); # use previously declared encoding
637             $mo->encode( $hash_ref => 'utf8' );
638              
639             # Reset cache and last modified timestamp
640             $mo->reset;
641              
642             =head1 VERSION
643              
644             v0.4.0
645              
646             =head1 DESCRIPTION
647              
648             C<Text::PO::MO> provides an interface for reading from and writing to GNU gettext binary C<.mo> (machine object) files.
649              
650             The module complements L<Text::PO> by allowing conversion between C<.po> text files and their portable binary representation used at runtime by gettext-enabled applications.
651              
652             It supports:
653              
654             =over 4
655              
656             =item * Automatic character decoding
657              
658             =item * Detection of encoding from the meta-information header
659              
660             =item * Caching of decoded key/value pairs
661              
662             =item * Full writing of C<.mo> files, including:
663              
664             =over 4
665              
666             =item * Proper synthesis of the header entry (msgid C<"">)
667              
668             =item * Context keys (msgctxt)
669              
670             =item * Singular and plural forms
671              
672             =item * Deterministic ordering compatible with L<msgfmt(1)>
673              
674             =back
675              
676             =back
677              
678             =head1 CONSTRUCTOR
679              
680             =head2 new
681              
682             my $mo = Text::PO::MO->new( $file, %options );
683              
684             Creates a new C<Text::PO::MO> object.
685              
686             It accepts the following options:
687              
688             =over 4
689              
690             =item * C<auto_decode>
691              
692             Boolean. If true, values returned by L</read> are automatically decoded according to L</encoding> or the meta-information of the file.
693              
694             =item * C<default_encoding>
695              
696             Encoding to fall back to when auto-decoding is enabled and no encoding could be determined from the C<Content-Type> header.
697              
698             =item * C<encoding>
699              
700             Explicit character encoding to use when decoding. Has priority over C<default_encoding>.
701              
702             =item * C<file>
703              
704             The C<.mo> file to read from or write to. May be given as a path or any C<Module::Generic::File>-compatible object.
705              
706             =item * C<use_cache>
707              
708             Boolean. If true (default), results of L</read> are cached and reused as long as the modification timestamp of the underlying file does not change.
709              
710             =back
711              
712             =head1 METHODS
713              
714             =head2 as_object
715              
716             my $po = $mo->as_object;
717              
718             Returns the result of L</read> as a L<Text::PO> object, allowing direct manipulation of PO elements.
719              
720             =head2 auto_decode
721              
722             Takes a boolean value and enables or disables auto decode of data read from C<.mo> file.
723              
724             This is used in L</read>
725              
726             =head2 decode
727              
728             my $ref = $mo->decode( \%hash, $encoding );
729              
730             Provided with an hash reference of key-value pairs and a string representing an optional encoding and this will decode all its keys and values.
731              
732             If no encoding is provided, it will use the value set with L</encoding>
733              
734             It returns the same hash reference, although being a reference, this is not necessary.
735              
736             =head2 default_encoding
737              
738             Sets the default encoding to revert to if no encoding is set with L</encoding> and L</auto_decode> is enabled.
739              
740             Otherwise, L</read> will attempt to find out the encoding used by looking at the meta information C<Content-type> inside the binary file.
741              
742             =head2 domain
743              
744             Sets or gets the po file domain associated with the translation catalogue, such as C<com.example.api>
745              
746             =head2 encoding
747              
748             Sets or gets the encoding used for decoding the data read from the C<.mo> file.
749              
750             =head2 file
751              
752             my $file = $mo->file( '/some/where/locale/en_US/LC_MESSAGES/com.example.api.mo' );
753              
754             Sets or gets the gnu C<.mo> file path to be read from or written to.
755              
756             Returns a L<file object|Module::Generic::File>
757              
758             =head2 read
759              
760             my $translations = $mo->read(
761             file => '/home/joe/locale/ja_JP/LC_MESSAGES/com.example.api.mo',
762             no_cache => 1,
763             auto_decode => 1,
764             default_encoding => 'utf8',
765             );
766              
767             Reads the GNU C<.mo> file and returns a hash reference mapping C<msgid> strings to their translated C<msgstr> values.
768              
769             The empty string key C<""> corresponds to the special header entry and its meta-information (e.g. C<Project-Id-Version>, C<Language>, C<Content-Type>, etc.).
770              
771             Recognised options:
772              
773             =over 4
774              
775             =item * C<auto_decode>
776              
777             Boolean value. If true, the data will be automatically decoded using either the character encoding specified with L</encoding> or the one found in the C<Content-type> field in the file meta information.
778              
779             =item * C<default_encoding>
780              
781             The default encoding to use if no encoding was set using L</encoding> and none could be found in the C<.mo> file meta information.
782              
783             =item * C<file>
784              
785             The C<.mo> file to read from.
786              
787             If not provided, this will default to using the value set upon object instantiation or with L</file>.
788              
789             =item * C<no_cache>
790              
791             Boolean value. If true, this will ignore any cached data and re-read the C<.mo> file.
792              
793             =back
794              
795             If caching is enabled with L</use_cache>, then L</read> will return the cache content instead of actually reading the C<.mo> unless the last modification time has changed and increased.
796              
797             Note that the <.mo> files store the elements in lexicographical order, and thus when reading from it, the order of the elements might not be the same as the one in the original C<.po> file.
798              
799             Upon error, this sets an L<error object|Module::Generic::Exception>, and returns C<undef> in scalar context, and an empty list in list context.
800              
801             =head2 reset
802              
803             $mo->reset;
804              
805             Resets the cached data. This will have the effect of reading the C<.mo> file next time L</read> is called.
806              
807             Returns the current object.
808              
809             =head2 revision
810              
811             Sets or gets the C<.mo> file format revision number. This should not be changed, or you might break things.
812              
813             It defaults to C<0>
814              
815             =head2 use_cache
816              
817             Takes a boolean value.
818              
819             If true, this will enable caching based on the C<.mo> file last modification timestamp.
820              
821             Default to true.
822              
823             =head2 write
824              
825             $mo->write( $po, \%options );
826              
827             Writes a binary C<.mo> file from a L<Text::PO> object, adding all the elements lexicographically, as required by GNU machine object format.
828              
829             Supported options are:
830              
831             =over 4
832              
833             =item * C<file>
834              
835             The output file to write the data to.
836              
837             Defaults to the object's C<file> attribute.
838              
839             =back
840              
841             The method:
842              
843             =over 4
844              
845             =item * Synthesises the header entry from C<< $po->meta >> (msgid C<"">)
846              
847             =item * Supports context (msgctxt) and plural forms
848              
849             =item * Concatenates plural translations using NUL separators
850              
851             =item * Writes deterministic index tables as required by GNU gettext
852              
853             =back
854              
855             =head1 THREAD-SAFETY
856              
857             This module is thread-safe. All state is stored on a per-object basis, and the underlying file operations and data structures do not share mutable global state.
858              
859             =head1 AUTHOR
860              
861             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
862              
863             =head1 SEE ALSO
864              
865             L<Text::PO>, L<Text::PO::Element>
866              
867             L<https://www.gnu.org/software/gettext/manual/html_node/PO-Files.html>
868              
869             L<http://www.gnu.org/software/gettext/manual/html_node/MO-Files.html#MO-Files>
870              
871             =head1 COPYRIGHT & LICENSE
872              
873             Copyright (c) 2020-2025 DEGUEST Pte. Ltd.
874              
875             You can use, copy, modify and redistribute this package and associated files under the same terms as Perl itself.
876              
877             =cut