File Coverage

lib/Text/PO/Element.pm
Criterion Covered Total %
statement 162 232 69.8
branch 51 94 54.2
condition 9 30 30.0
subroutine 33 44 75.0
pod 32 32 100.0
total 287 432 66.4


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## PO Files Manipulation - ~/lib/Text/PO/Element.pm
3             ## Version v0.2.1
4             ## Copyright(c) 2022 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2021/07/23
7             ## Modified 2023/06/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::Element;
14             BEGIN
15 0         0 {
16 4     4   58 use strict;
  4         9  
  4         153  
17 4     4   31 use warnings;
  4         11  
  4         187  
18 4     4   28 use parent qw( Module::Generic );
  4         7  
  4         41  
19 4     4   342 use vars qw( $VERSION );
  4         9  
  4         223  
20 4     4   2007 use Text::Wrap ();
  4         14945  
  4         212  
21 4     4   725 our $VERSION = 'v0.2.1';
22 4     4   27 use open ':std' => ':utf8';
  4         6  
  4         47  
23             };
24              
25 4     4   25 use strict;
  4         9  
  4         79  
26 4     4   29 use warnings;
  4         6  
  4         9484  
27              
28             $Text::Wrap::columns = 80;
29              
30             sub init
31             {
32 51     51 1 3899 my $self = shift( @_ );
33 51         338 $self->{msgid} = '';
34 51         132 $self->{msgstr} = '';
35 51         155 $self->{msgid_plural} = '';
36 51         147 $self->{context} = '';
37 51         147 $self->{fuzzy} = '';
38 51         143 $self->{comment} = [];
39 51         105 $self->{auto_comment} = [];
40             # e.g.: c-format
41 51         154 $self->{flags} = [];
42             # Is it plural?
43 51         123 $self->{plural} = 0;
44             # reference
45 51         120 $self->{file} = '';
46 51         171 $self->{line} = '';
47 51         142 $self->{encoding} = '';
48             # Parent po object
49 51         173 $self->{po} = '';
50 51         125 $self->{is_meta} = 0;
51 51         136 $self->{_po_line} = 0;
52 51         146 $self->{_init_strict_use_sub} = 1;
53 51         211 $self->SUPER::init( @_ );
54 51         2085 return( $self );
55             }
56              
57 0     0 1 0 sub add_auto_comment { return( shift->_add( 'auto_comment', @_ ) ); }
58              
59 0     0 1 0 sub add_comment { return( shift->_add( 'comment', @_ ) ); }
60              
61 4     4 1 29 sub add_msgid { return( shift->_add( 'msgid', @_ ) ); }
62              
63 0     0 1 0 sub add_msgid_plural { return( shift->_add( 'msgid_plural', @_ ) ); }
64              
65 39     39 1 100 sub add_msgstr { return( shift->_add( 'msgstr', @_ ) ); }
66              
67             sub add_reference
68             {
69 0     0 1 0 my $self = shift( @_ );
70 0 0       0 if( @_ )
71             {
72             ## If there is any existing value, convert it to array
73 0 0 0     0 $self->{file} = [$self->{file}] if( length( $self->{file} ) && $self->_is_array( $self->{file} ) );
74 0 0 0     0 $self->{line} = [$self->{line}] if( length( $self->{line} ) && $self->_is_array( $self->{line} ) );
75 0 0       0 if( $self->_is_array( $_[0] ) )
76             {
77 0         0 push( @{$self->{file}}, $_[0]->[0] );
  0         0  
78 0         0 push( @{$self->{line}}, $_[0]->[1] );
  0         0  
79             }
80             else
81             {
82 0         0 push( @{$self->{file}}, shift( @_ ) );
  0         0  
83 0         0 push( @{$self->{line}}, shift( @_ ) );
  0         0  
84             }
85             }
86 0         0 return( $self );
87             }
88              
89 0     0 1 0 sub auto_comment { return( shift->_set_get_array( 'auto_comment', @_ ) ); }
90              
91 8     8 1 25 sub comment { return( shift->_set_get_array( 'comment', @_ ) ); }
92              
93 19     19 1 75 sub context { return( shift->_set_get_scalar( 'context', @_ ) ); }
94              
95             sub delete
96             {
97 0     0 1 0 my $self = shift( @_ );
98 0         0 my $po = $self->po;
99 0 0       0 return( $self->error( "No Text::PO object set." ) ) if( !$po );
100 0         0 return( $po->remove_element( $self ) );
101             }
102              
103             sub dump
104             {
105 8     8 1 18 my $self = shift( @_ );
106 8         21 my @res = ();
107 8 50       14 push( @res, '# ' . join( "\n# ", @{$self->{comment}} ) ) if( scalar( @{$self->{comment}} ) );
  0         0  
  8         61  
108 8 50       18 push( @res, '#. ' . join( "\n#. ", @{$self->{auto_comment}} ) ) if( scalar( @{$self->{auto_comment}} ) );
  0         0  
  8         46  
109 8         40 my $ref = $self->reference;
110 8 100       28 push( @res, "#: $ref" ) if( length( $ref ) );
111 8         25 my $flags = $self->flags;
112 8 50       165 if( scalar( @$flags ) )
113             {
114 0         0 push( @res, sprintf( '#, %s', join( ", ", @$flags ) ) );
115             }
116 8 50       45 push( @res, sprintf( 'msgctxt: "%s"', $self->po->quote( $self->{context} ) ) ) if( length( $self->{context} ) );
117 8         24 foreach my $k ( qw( msgid msgid_plural ) )
118             {
119 16 50       91 if( $self->can( "${k}_as_string" ) )
120             {
121 16         32 my $sub = "${k}_as_string";
122 16         44 push( @res, $self->$sub() );
123             }
124             else
125             {
126 0 0 0     0 if( ref( $self->{ $k } ) && scalar( @{$self->{ $k }} ) )
  0 0 0     0  
127             {
128 0         0 push( @res, sprintf( '%s ""', $k ) );
129 0         0 push( @res, map( sprintf( '"%s"', $self->po->quote( $_ ) ), @{$self->{ $k }} ) );
  0         0  
130             }
131             elsif( !ref( $self->{ $k } ) && length( $self->{ $k } ) )
132             {
133 0         0 push( @res, sprintf( '%s "%s"', $k, $self->po->quote( $self->{ $k } ) ) );
134             }
135             }
136             }
137 8         33 push( @res, $self->msgstr_as_string );
138 8         45 return( join( "\n", @res ) );
139             }
140              
141 27     27 1 8765 sub encoding { return( shift->_set_get_scalar( 'encoding', @_ ) ); }
142              
143 0     0 1 0 sub file { return( shift->_set_get_scalar( 'file', @_ ) ); }
144              
145 16     16 1 61 sub flags { return( shift->_set_get_array( 'flags', @_ ) ); }
146              
147 0     0 1 0 sub fuzzy { return( shift->_set_get_boolean( 'fuzzy', @_ ) ); }
148              
149             sub id
150             {
151 21     21 1 35 my $self = shift( @_ );
152 21         51 my $msgid = $self->msgid;
153 21 100       372 if( ref( $msgid ) )
154             {
155 2         26 return( CORE::join( '', @$msgid ) );
156             }
157             else
158             {
159 19         140 return( $msgid );
160             }
161             }
162              
163 34     34 1 246 sub is_meta { return( shift->_set_get_boolean( 'is_meta', @_ ) ); }
164              
165 0     0 1 0 sub line { return( shift->_set_get_number( 'line', @_ ) ); }
166              
167             sub merge
168             {
169 0     0 1 0 my $self = shift( @_ );
170 0   0     0 my $elem = shift( @_ ) || return( $self->error( "No element object was provided." ) );
171 0 0 0     0 return( $self->error( "Object provided ($elem) is not an Text::PO::Element object" ) ) if( !$self->_is_object( $elem ) || !$elem->isa( 'Text::PO::Element' ) );
172 0         0 my @k = grep( !/^po$/, keys( %$elem ) );
173 0         0 foreach( @k )
174             {
175 0 0       0 $self->{ $_ } = $elem->{ $_ } if( !length( $self->{ $_ } ) );
176             }
177 0         0 return( $self );
178             }
179              
180 130     130 1 16248 sub msgid { return( shift->_set_get( 'msgid', @_ ) ); }
181              
182             sub msgid_as_string
183             {
184 8     8 1 22 my $self = shift( @_ );
185 8         27 return( $self->normalise( 'msgid', $self->{msgid} ) );
186             }
187              
188 15     15 1 1025 sub msgid_plural { return( shift->_set_get( 'msgid_plural', @_ ) ); }
189              
190             sub msgid_plural_as_string
191             {
192 8     8 1 17 my $self = shift( @_ );
193             # Important to return undef and not an empty string if there is no plural msgid
194             # undef will not be added to the list, but empty string would
195 8 100       62 return if( !CORE::length( $self->{msgid_plural} ) );
196 1         10 return( $self->normalise( 'msgid_plural', $self->{msgid_plural} ) );
197             }
198              
199             # sub msgstr { return( shift->_set_get( 'msgstr', @_ ) ); }
200             sub msgstr
201             {
202 81     81 1 1348 my $self = shift( @_ );
203 81 100       201 if( @_ )
204             {
205 51 100       159 if( @_ == 2 )
206             {
207 11         81 my( $pos, $str ) = @_;
208 11 50       171 return( $self->error( "msgstr plural offset \"$pos\" is not an integer." ) ) if( $pos !~ /^\d+$/ );
209 11         80 $pos = int( $pos );
210 11 100       96 $self->{msgstr} = [] if( ref( $self->{msgstr} ) ne 'ARRAY' );
211 11 50       57 $self->{msgstr}->[ $pos ] = [] if( ref( $self->{msgstr}->[ $pos ] ) ne 'ARRAY' );
212 11         20 push( @{$self->{msgstr}->[ $pos ]}, $str );
  11         36  
213             }
214             else
215             {
216 40 100       118 if( !ref( $_[0] ) )
217             {
218 37         78 chomp( @_ );
219             }
220 40         91 $self->{msgstr} = shift( @_ );
221             }
222             }
223 81         227 return( $self->{msgstr} );
224             }
225              
226             sub msgstr_as_string
227             {
228 8     8 1 15 my $self = shift( @_ );
229 8         18 my @res = ();
230 8 100       23 if( $self->plural )
231             {
232 1         697 for( my $i = 0; $i < scalar( @{$self->{msgstr}} ); $i++ )
  3         14  
233             {
234 2         5 my $ref = $self->{msgstr}->[$i];
235             # Is this a multiline plural localised text?
236             # msgstr[0] ""
237             # "some long line text"
238             # "2nd line of localised text"
239 2 50       13 if( scalar( @$ref ) > 1 )
240             {
241 0         0 push( @res, sprintf( 'msgstr[%d] ""', $i ) );
242 0         0 push( @res, map( sprintf( '"%s"', $self->po->quote( $_ ) ), @$ref ) );
243             }
244             # Regular plural localised text msgstr[0] "some text"
245             else
246             {
247 2 50       16 push( @res, sprintf( 'msgstr[%d] "%s"', $i, $self->po->quote( $ref->[0] ) ) ) if( length( $ref->[0] ) );
248             }
249             }
250 1         15 return( join( "\n", @res ) );
251             }
252             else
253             {
254 7         4878 return( $self->normalise( 'msgstr', $self->{msgstr} ) );
255             }
256             }
257              
258             sub normalise
259             {
260 16     16 1 27 my $self = shift( @_ );
261 16         40 my $type = shift( @_ );
262 16         34 my $text = shift( @_ );
263 16         28 my @res = ();
264 16         25 my $lines;
265 16 100 100     112 if( ref( $text ) && scalar( @$text ) )
    50 33        
266             {
267 2         24 $lines = $self->wrap( join( '', @$text ) );
268             }
269             elsif( !ref( $text ) && length( $text ) )
270             {
271 14         45 $lines = $self->wrap( $text );
272             }
273            
274 16 100       41 if( scalar( @$lines ) > 1 )
275             {
276 2         8 push( @res, sprintf( '%s ""', $type ) );
277 2         20 push( @res, map( sprintf( '"%s"', $_ ), @$lines ) );
278             }
279             else
280             {
281 14         62 push( @res, sprintf( '%s "%s"', $type, $lines->[0] ) );
282             }
283 16         83 return( join( "\n", @res ) );
284             }
285              
286 40     40 1 142 sub plural { return( shift->_set_get_boolean( 'plural', @_ ) ); }
287              
288 79     79 1 4805 sub po { return( shift->_set_get_object( 'po', 'Text::PO', @_ ) ); }#
289              
290             sub reference
291             {
292 31     31 1 66 my $self = shift( @_ );
293 31 100       89 if( @_ )
294             {
295 15 50       114 if( $self->_is_array( $_[0] ) )
296             {
297             ## Multi references:
298             ## colorscheme.cpp:79 skycomponents/equator.cpp:31
299 0 0       0 if( $self->_is_array( $_[0]->[0] ) )
300             {
301 0         0 $self->{file} = [];
302 0         0 $self->{line} = [];
303 0         0 foreach my $a ( @{$_[0]} )
  0         0  
304             {
305 0         0 push( @{$self->{file}}, $a->[0] );
  0         0  
306 0         0 push( @{$self->{line}}, $a->[1] );
  0         0  
307             }
308             }
309             else
310             {
311 0         0 @$self{ qw( file line ) } = @{$_[0]};
  0         0  
312             }
313             }
314             else
315             {
316 15         276 @$self{ qw( file line ) } = split( /:/, shift( @_ ), 2 );
317             }
318             }
319 31 100 100     289 return( '' ) if( !length( $self->{file} ) || !length( $self->{line} ) );
320 19 50 33     94 return( '' ) if( $self->_is_array( $self->{file} ) && !scalar( @{$self->{file}} ) );
  0         0  
321 19 50       237 if( $self->_is_array( $self->{file} ) )
322             {
323 0         0 my @temp = ();
324 0         0 for( my $i = 0; $i < scalar( @{$self->{file}} ); $i++ )
  0         0  
325             {
326 0         0 push( @temp, join( ':', $self->{file}->[$i], $self->{line}->[$i] ) );
327             }
328 0         0 return( join( ' ', @temp ) );
329             }
330             else
331             {
332 19         237 return( join( ':', @$self{ qw( file line ) } ) );
333             }
334             }
335              
336             sub wrap
337             {
338 16     16 1 27 my $self = shift( @_ );
339 16         21 my $text = shift( @_ );
340 16         21 my $max = 80;
341 16 100       48 if( length( $text ) > $max )
342             {
343 2         30 my $lines = [split( /\n/, $text )];
344 2         20 for( my $i = 0; $i < scalar( @$lines ); $i++ )
345             {
346 2 50       20 if( length( $lines->[$i] ) > $max )
347             {
348 2         18 my $newLines = $self->wrap_line( $lines->[$i] );
349 2         12 splice( @$lines, $i, 1, @$newLines );
350 2         12 $i += scalar( @$newLines ) - 1;
351             }
352             else
353             {
354 0         0 $lines->[$i] = $self->po->quote( $lines->[$i] . "\n" );
355             }
356             }
357 2         7 return( $lines );
358             }
359             else
360             {
361 14         27 return( [ $self->po->quote( $text ) ] );
362             }
363             }
364              
365             sub wrap_line
366             {
367 2     2 1 9 my $self = shift( @_ );
368 2         8 my $text = shift( @_ );
369 2 50       14 return( [] ) if( !length( $text ) );
370 2         24 my $new = Text::Wrap::wrap( '', '', $text );
371 2         2679 my $newLines = [split( /\n/, $new )];
372 2         12 for( my $j = 0; $j < scalar( @$newLines ); $j++ )
373             {
374 4 100       19 $newLines->[$j] .= ' ' unless( $j == $#${newLines} );
375 4         12 $newLines->[$j] = $self->po->quote( $newLines->[$j] );
376             }
377             #$newLines->[ $#${newLines} ] = $self->po->quote( $newLines->[ $#${newLines} ] );
378 2         16 return( $newLines );
379             }
380              
381             sub _add
382             {
383 43     43   56 my $self = shift( @_ );
384 43         71 my $what = shift( @_ );
385             #chomp( @_ );
386 43 100       163 $self->{ $what } = [] if( !ref( $self->{ $what } ) );
387 43         47 push( @{$self->{ $what }}, @_ );
  43         90  
388 43         191 return( $self );
389             }
390              
391             sub _set_get
392             {
393 145     145   220 my $self = shift( @_ );
394 145         240 my $name = shift( @_ );
395 145 100       313 if( @_ )
396             {
397 50 100 66     275 if( !ref( $_[0] ) && length( $_[0] ) )
398             {
399 47         104 chomp( @_ );
400             }
401 50 100       185 $self->plural(1) if( $name eq 'msgid_plural' );
402 50         3663 return( $self->SUPER::_set_get( $name, @_ ) );
403             }
404 95         233 return( $self->SUPER::_set_get( $name ) );
405             }
406              
407             sub _set_get_msg_property
408             {
409 0     0     my $self = shift( @_ );
410 0           my $prop = shift( @_ );
411 0 0         $self->_set_get( $prop, @_ ) if( @_ );
412 0 0         if( ref( $self->{ $prop } ) )
413             {
414 0 0         return( wantarray() ? ( @{$self->{ $prop }} ) : join( '', @{$self->{ $prop }} ) );
  0            
  0            
415             }
416             else
417             {
418 0 0         return( wantarray() ? ( $self->{ $prop } ) : $self->{ $prop } );
419             }
420             }
421              
422             1;
423             # NOTE: POD
424             __END__
425              
426             =encoding utf-8
427              
428             =head1 NAME
429              
430             Text::PO::Element - PO Element
431              
432             =head1 SYNOPSIS
433              
434             use Text::PO::Element;
435             my $po = Text::PO::Element->new;
436             $po->debug( 2 );
437             $po->dump;
438              
439             =head1 VERSION
440              
441             v0.2.1
442              
443             =head1 DESCRIPTION
444              
445             This is the class for PO elements.
446              
447             =head2 CONSTRUCTOR
448              
449             =head2 new
450              
451             Create a new Text::PO::Element object acting as an accessor.
452              
453             =head2 ATTRIBUTES
454              
455             A C<Text::PO::Element> object has the following fields :
456              
457             =over 4
458              
459             =item I<msgid>
460              
461             The localisation id
462              
463             =item I<msgstr>
464              
465             The localised string
466              
467             =item I<msgid_plural>
468              
469             The optional localised string in plural
470              
471             =item I<context>
472              
473             The optional context.
474              
475             =item I<fuzzy>
476              
477             The fuzzy flag set when the entry has been created but not yet translated
478              
479             =item I<comment>
480              
481             The optional comment that can be added to provide some explanations to the translator
482              
483             =item I<auto_comment>
484              
485             The optional comment added automatically
486              
487             =item I<flags>
488              
489             An optional set of flags, stored as an array reference
490              
491             =item I<plural>
492              
493             Whether this has a plural form
494              
495             =item I<encoding>
496              
497             The character encoding
498              
499             =item I<file>
500              
501             The file in which this l10n string was found. This is set when automatic parsing was executed
502              
503             =item I<line>
504              
505             The line at which this l10n was found. This is set when automatic parsing was executed
506              
507             =item I<po>
508              
509             The parent C<Text::PO> object
510              
511             =item I<is_meta>
512              
513             An optional boolean value provided if this element represents a meta information
514              
515             =back
516              
517             =head1 METHODS
518              
519             =head2 add_auto_comment
520              
521             Add an auto comment
522              
523             =head2 add_comment
524              
525             Add a comment
526              
527             =head2 add_msgid
528              
529             Add a msgid
530              
531             =head2 add_msgid_plural
532              
533             Add a plural version of a msgid
534              
535             =head2 add_msgstr
536              
537             Add a msgstr
538              
539             =head2 add_reference
540              
541             Add a reference, which is a file and line number
542              
543             =head2 auto_comment
544              
545             Set or return the auto_comment field
546              
547             =head2 comment
548              
549             Set or return the comment field
550              
551             =head2 context
552              
553             Set or return the context field
554              
555             =head2 delete
556              
557             Remove the element from the list of elements in L<Text::PO>
558              
559             This only works if the element was added via L<Text::PO>, or else you need to have set yourself the L<Text::PO> object with the L</po> method.
560              
561             =head2 dump
562              
563             Return the element as a string formatted for a po file.
564              
565             =head2 flags
566              
567             Set or return the flags as array reference
568              
569             =head2 id
570              
571             Return the value of L<msgid> as a string
572              
573             =head2 is_meta
574              
575             Set or gets the flag that this element represents the meta information for this PO (a.k.a portable object) file.
576              
577             Meta information for a po file is stored in a unique msgid whose value is null.
578              
579             =head2 merge( Text::PO::Element )
580              
581             Given a C<Text::PO::Element> object, it merge its content with our element object.
582              
583             The merge will not overwrite existing fields.
584              
585             It returns the current object
586              
587             =head2 msgstr
588              
589             Set or return the msgstr as a value without surrounding quote and without escaping.
590              
591             =head2 msgid_as_string
592              
593             This returns the msgid escaped and with surrounding quotes, suitable for L</dump>
594              
595             =head2 msgid_plural_as_string
596              
597             Returns the C<msgid> property as a string when it has plural implemented.
598              
599             =head2 msgstr_as_string
600              
601             This returns the msgstr escaped and with surrounding quotes, suitable for L</dump>
602              
603             =head2 normalise
604              
605             L</normalise> will return a string properly formatted with double quotes, multi lines if necessary, suitable for L</dump>
606              
607             =head2 po
608              
609             Sets or gets the L<Text::PO> object associated with this element. Best that you know what you are doing if you change this.
610              
611             =head2 reference
612              
613             Given an array reference or a string separated by ':', it sets the file and line number for this element object.
614              
615             =head2 wrap
616              
617             Given a text, it returns an array reference of lines wrapped
618              
619             =head2 wrap_line
620              
621             Given a string, it returns an array reference of lines. This is called by L</wrap>
622              
623             =head1 AUTHOR
624              
625             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
626              
627             =head1 SEE ALSO
628              
629             L<https://www.gnu.org/software/gettext/manual/html_node/PO-Files.html>
630              
631             =head1 COPYRIGHT & LICENSE
632              
633             Copyright (c) 2020-2021 DEGUEST Pte. Ltd.
634              
635             You can use, copy, modify and redistribute this package and associated files under the same terms as Perl itself.
636              
637             =cut