File Coverage

blib/lib/Locale/Maketext/Lexicon/Getcontext.pm
Criterion Covered Total %
statement 61 69 88.4
branch 30 54 55.5
condition 14 34 41.1
subroutine 7 9 77.7
pod 0 5 0.0
total 112 171 65.5


line stmt bran cond sub pod time code
1             package Locale::Maketext::Lexicon::Getcontext;
2              
3 3     3   4045 use strict;
  3         6  
  3         72  
4              
5 3     3   1213 use Locale::Maketext::Lexicon::Gettext;
  3         4141  
  3         311  
6              
7             our $VERSION = "0.05";
8             my ( $InputEncoding, $OutputEncoding, $DoEncoding );
9              
10 0     0 0 0 sub input_encoding {$InputEncoding}
11 0     0 0 0 sub output_encoding {$OutputEncoding}
12              
13             # functions
14             *parse_mo = \&Locale::Maketext::Lexicon::Gettext::parse_mo;
15             *_unescape = \&Locale::Maketext::Lexicon::Gettext::_unescape;
16             *_gettext_to_maketext
17             = \&Locale::Maketext::Lexicon::Gettext::_gettext_to_maketext;
18              
19              
20              
21             #
22             # parse()
23             # -----
24             # copy-pasted from Locale::Maketext::Lexicon::Gettext, with s/msgid/msgctxt/g
25             #
26             sub parse {
27 8     8 0 23090 my $self = shift;
28 8         36 my ( %var, $key, @ret );
29 8         0 my @metadata;
30 8         0 my @comments;
31 8         0 my @fuzzy;
32              
33 8         20 $InputEncoding = $OutputEncoding = $DoEncoding = undef;
34              
35 3     3   18 use Carp;
  3         6  
  3         2700  
36 8 50       25 Carp::cluck "Undefined source called\n" unless defined $_[0];
37              
38             # Check for magic string of MO files
39 8 50 33     47 return parse_mo( join( '', @_ ) )
40             if ( $_[0] =~ /^\x95\x04\x12\xde/ or $_[0] =~ /^\xde\x12\x04\x95/ );
41              
42 8         33 local $^W; # no 'uninitialized' warnings, please.
43              
44 8         53 require Locale::Maketext::Lexicon;
45 8         28 my $KeepFuzzy = Locale::Maketext::Lexicon::option('keep_fuzzy');
46 8   33     71 my $UseFuzzy = $KeepFuzzy
47             || Locale::Maketext::Lexicon::option('use_fuzzy');
48 8         46 my $AllowEmpty = Locale::Maketext::Lexicon::option('allow_empty');
49             my $process = sub {
50 3470 50 33 3470   10622 if ( length( $var{msgstr} ) and ( $UseFuzzy or !$var{fuzzy} ) ) {
    0 33        
51 3470         6981 push @ret, ( map transform($_), @var{ 'msgctxt', 'msgstr' } );
52             }
53             elsif ($AllowEmpty) {
54 0         0 push @ret, ( transform( $var{msgctxt} ), '' );
55             }
56 3470 100       35748 if ( $var{msgctxt} eq '' ) {
57 8         19 push @metadata, parse_metadata( $var{msgstr} );
58             }
59             else {
60 3462         5821 push @comments, $var{msgctxt}, $var{msgcomment};
61             }
62 3470 0 33     5628 if ( $KeepFuzzy && $var{fuzzy} ) {
63 0         0 push @fuzzy, $var{msgctxt}, 1;
64             }
65 3470         7515 %var = ();
66 8         58 };
67              
68             # Parse PO files
69 8         19 foreach (@_) {
70 15406         60561 s/[\015\012]*\z//; # fix CRLF issues
71              
72             /^(msgctxt|msgid|msgstr) +"(.*)" *$/
73             ? do { # leading strings
74 10402         22718 $var{$1} = $2;
75 10402         15798 $key = $1;
76             }
77             :
78              
79             /^"(.*)" *$/
80             ? do { # continued strings
81 1534         3126 $var{$key} .= $1;
82             }
83             :
84              
85             /^# (.*)$/
86             ? do { # user comments
87 0         0 $var{msgcomment} .= $1 . "\n";
88             }
89             :
90              
91             /^#, +(.*) *$/
92             ? do { # control variables
93 0         0 $var{$_} = 1 for split( /,\s+/, $1 );
94             }
95             :
96              
97             /^ *$/ && %var
98 15406 50 33     43630 ? do { # interpolate string escapes
    50          
    50          
    100          
    100          
99 3470         5752 $process->($_);
100             }
101             : ();
102              
103             }
104              
105             # do not silently skip last entry
106 8 50       27 $process->() if keys %var != 0;
107              
108 0         0 push @ret, map { transform($_) } @var{ 'msgctxt', 'msgstr' }
109 8 50       28 if length $var{msgstr};
110             push @metadata, parse_metadata( $var{msgstr} )
111 8 50       38 if $var{msgctxt} eq '';
112              
113             return wantarray
114 8 50       3411 ? ( { @metadata, @ret }, {@comments}, {@fuzzy} )
115             : ( { @metadata, @ret } );
116              
117             }
118              
119              
120             #
121             # parse_metadata()
122             # --------------
123             # copy-pasted from Locale::Maketext::Lexicon::Gettext, with no change,
124             # because it accesses the $InputEncoding and $OutputEncoding vars
125             #
126             sub parse_metadata {
127             return map {
128 16     16 0 35 (/^([^\x00-\x1f\x80-\xff :=]+):\s*(.*)$/)
129             ? ( $1 eq 'Content-Type' )
130 64 100       581 ? do {
    50          
131 8         18 my $enc = $2;
132 8 50       35 if ( $enc =~ /\bcharset=\s*([-\w]+)/i ) {
133 8   50     24 $InputEncoding = $1 || '';
134 8   50     26 $OutputEncoding
135             = Locale::Maketext::Lexicon::encoding()
136             || '';
137 8 50       92 $InputEncoding = 'utf8'
138             if $InputEncoding =~ /^utf-?8$/i;
139 8 50       20 $OutputEncoding = 'utf8'
140             if $OutputEncoding =~ /^utf-?8$/i;
141 8 50 33     17 if (Locale::Maketext::Lexicon::option('decode')
      33        
142             and ( !$OutputEncoding
143             or $InputEncoding ne $OutputEncoding )
144             )
145             {
146 8 50       58 require Encode::compat if $] < 5.007001;
147 8         34 require Encode;
148 8         14 $DoEncoding = 1;
149             }
150             }
151 8         19 ( "__Content-Type", $enc );
152             }
153             : ( "__$1", $2 )
154             : ();
155             } split( /\r*\n+\r*/, transform(pop) );
156             }
157              
158              
159             #
160             # transform()
161             # ---------
162             # copy-pasted from Locale::Maketext::Lexicon::Gettext, with no change,
163             # because it accesses the $InputEncoding and $OutputEncoding vars
164             #
165             sub transform {
166 6956     6956 0 34204 my $str = shift;
167              
168 6956 100 66     16414 if ( $DoEncoding and $InputEncoding ) {
169 6932 50       13872 $str
170             = ( $InputEncoding eq 'utf8' )
171             ? Encode::decode_utf8($str)
172             : Encode::decode( $InputEncoding, $str );
173             }
174              
175 6956         96669 $str =~ s/\\([0x]..|c?.)/qq{"\\$1"}/eeg;
  1918         68022  
176              
177 6956 50 66     18336 if ( $DoEncoding and $OutputEncoding ) {
178 0 0       0 $str
179             = ( $OutputEncoding eq 'utf8' )
180             ? Encode::encode_utf8($str)
181             : Encode::encode( $OutputEncoding, $str );
182             }
183              
184 6956 100       12075 return Locale::Maketext::Lexicon::option('disable_maketext_conversion')
185             ? $str : _gettext_to_maketext($str);
186             }
187              
188              
189             __PACKAGE__
190              
191             __END__