1use strict;
2use warnings;
3
4package Jifty::I18N;
5use base 'Locale::Maketext';
6use Locale::Maketext::Lexicon ();
7use Email::MIME::ContentType;
8use Encode::Guess qw(iso-8859-1);
9use Jifty::Util;
10
11=head1 NAME
12
13Jifty::I18N - Internationalization framework for Jifty
14
15=head1 SYNOPSIS
16
17  # Whenever you need an internationalized string:
18  print _('Hello, %1!', 'World');
19
20In your Mason templates:
21
22  <% _('Hello, %1!', 'World') %>
23
24=head1 METHODS
25
26=head2 C<_>
27
28This module provides a method named C<_>, which allows you to quickly and easily include localized strings in your application. The first argument is the string to be translated. If that string contains placeholders, the remaining arguments are used to replace the placeholders. The placeholders in the form of "%1" where the number is the number of the argument used to replace it:
29
30  _('Welcome %1 to the %2', 'Bob', 'World');
31
32This example would return the string "Welcome Bob to the World" if no translation is being performed.
33
34=cut
35
36=head2 new
37
38Set up Jifty's internationalization for your application.  This pulls
39in Jifty's PO files, your PO files and then exports the _ function into
40the wider world.
41
42=cut
43
44my $DynamicLH;
45
46our $loaded;
47
48sub new {
49    my $class = shift;
50    my $self  = {};
51    bless $self, $class;
52
53    # XXX: this requires a full review, LML->get_handle is calling new
54    # on I18N::lang each time, but we really shouldn't need to rerun
55    # the import here.
56    return $self if $loaded;
57
58    my @import = map {( Gettext => $_ )} _get_file_patterns();
59    ++$loaded;
60
61    Locale::Maketext::Lexicon->import(
62        {   '*' => \@import,
63            _decode => 1,
64            _auto   => 1,
65            _style  => 'gettext',
66        }
67    );
68
69    # Allow hard-coded languages in the config file
70    my $lang = Jifty->config->framework('L10N')->{'Lang'};
71    $lang = [defined $lang ? $lang : ()] unless ref($lang) eq 'ARRAY';
72
73    # Allow hard-coded allowed-languages in the config file
74    my $allowed_lang = Jifty->config->framework('L10N')->{'AllowedLang'};
75    $allowed_lang = [defined $allowed_lang ? $allowed_lang : ()] unless ref($allowed_lang) eq 'ARRAY';
76
77    if (@$allowed_lang) {
78        my $allowed_regex = join '|', map {
79            my $it = $_;
80            $it =~ tr<-A-Z><_a-z>; # lc, and turn - to _
81            $it =~ tr<_a-z0-9><>cd;  # remove all but a-z0-9_
82            $it;
83        } @$allowed_lang;
84
85        foreach my $lang ($self->available_languages) {
86            # "AllowedLang: zh" should let both zh_tw and zh_cn survive,
87            # so we just check ^ but not $.
88            $lang =~ /^$allowed_regex/ or delete $Jifty::I18N::{$lang.'::'};
89        }
90    }
91
92    my $lh = $class->get_handle(@$lang);
93
94    $DynamicLH = \$lh unless @$lang;
95    $self->init;
96
97    __PACKAGE__->install_global_loc($DynamicLH);
98    return $self;
99}
100
101=head2 install_global_loc
102
103=cut
104
105sub install_global_loc {
106    my ($class, $dlh) = @_;
107    my $loc_method = sub {
108        # Retain compatibility with people using "-e _" etc.
109        return \*_ unless @_; # Needed for perl 5.8
110
111        # When $_[0] is undef, return undef.  When it is '', return ''.
112        no warnings 'uninitialized';
113        return $_[0] unless (length $_[0]);
114
115        local $@;
116        # Force stringification to stop Locale::Maketext from choking on
117        # things like DateTime objects.
118        my @stringified_args = map {"$_"} @_;
119        my $result = eval { ${$dlh}->maketext(@stringified_args) };
120        if ($@) {
121            warn $@;
122            # Sometimes Locale::Maketext fails to localize a string and throws
123            # an exception instead.  In that case, we just return the input.
124            return join(' ', @stringified_args);
125        }
126        return $result;
127    };
128
129    {
130        no strict 'refs';
131        no warnings 'redefine';
132        *_ = $loc_method;
133    }
134}
135
136=head2 available_languages
137
138Return an array of available languages
139
140=cut
141
142sub available_languages {
143    return map { /^(\w+)::/ ? $1 : () } sort keys %Jifty::I18N::;
144}
145
146=head2 _get_file_patterns
147
148Get list of patterns for all PO files in the project.
149(Paths are gotten from the configuration variables and plugins).
150
151=cut
152
153sub _get_file_patterns {
154    my @ret;
155
156    push(@ret, Jifty->config->framework('L10N')->{'PoDir'});
157    push(@ret, Jifty->config->framework('L10N')->{'DefaultPoDir'});
158
159    # Convert relative paths to absolute ones
160    @ret = map { Jifty::Util->absolute_path($_) } @ret;
161
162    foreach my $plugin (Jifty->plugins) {
163        my $dir = $plugin->po_root;
164        next unless ($dir and -d $dir and -r $dir );
165        push @ret, $dir ;
166    }
167
168    # Unique-ify paths
169    my %seen;
170    @ret = grep {not $seen{$_}++} @ret;
171
172    return ( map { $_ . '/*.po' } @ret );
173}
174
175=head2 get_language_handle
176
177Get the language handle for this request.
178
179=cut
180
181sub get_language_handle {
182    # XXX: subrequest should not need to get_handle again.
183    my $self = shift;
184    # optional argument makes it easy to disable I18N
185    # while comparing test strings (without loading session)
186    my $lang = shift || Jifty->web->session->get('jifty_lang');
187
188    if (   !$lang
189        && Jifty->web->current_user
190        && Jifty->web->current_user->id )
191    {
192        my $user = Jifty->web->current_user->user_object;
193        for my $column (qw/language lang/) {
194            if ( $user->can($column) ) {
195                $lang = $user->$column;
196                last;
197            }
198        }
199    }
200
201    # I18N::LangTags::Detect wants these for detecting
202    local $ENV{REQUEST_METHOD} = Jifty->web->request->method
203        if Jifty->web->request;
204    local $ENV{HTTP_ACCEPT_LANGUAGE} = Jifty->web->request->header("Accept-Language") || ""
205        if Jifty->web->request;
206    $$DynamicLH = $self->get_handle($lang ? $lang : ()) if $DynamicLH;
207}
208
209=head2 get_current_language
210
211Get the current language for this request, formatted as a Locale::Maketext
212subclass string (i.e., C<zh_tw> instead of C<zh-TW>).
213
214=cut
215
216sub get_current_language {
217    return unless $DynamicLH;
218
219    my ($lang) = ref($$DynamicLH) =~ m/::(\w+)$/;
220    return $lang;
221}
222
223=head2 refresh
224
225Used by L<Jifty::Handler> in DevelMode to reload F<.po> files whenever they
226are modified on disk.
227
228=cut
229
230my $LAST_MODIFED = '';
231sub refresh {
232    if ( Jifty->config->framework('L10N')->{'Disable'} && !$loaded) {
233        # skip loading po, but still do the translation for maketext
234        require Locale::Maketext::Lexicon;
235        my $lh = __PACKAGE__->get_handle;
236        my $orig = Jifty::I18N::en->can('maketext');
237        no warnings 'redefine';
238        *Jifty::I18N::en::maketext = Locale::Maketext::Lexicon->_style_gettext($orig);
239        __PACKAGE__->install_global_loc(\$lh);
240        ++$loaded;
241        return;
242    }
243
244    my $modified = join(
245        ',',
246        #   sort map { $_ => -M $_ } map { glob("$_/*.po") } ( Jifty->config->framework('L10N')->{'PoDir'}, Jifty->config->framework('L10N')->{'DefaultPoDir'}
247        sort map { $_ => -M $_ } map { glob($_) } _get_file_patterns()
248    );
249    if ($modified ne $LAST_MODIFED) {
250        Jifty::I18N->new;
251        $LAST_MODIFED = $modified;
252    }
253}
254
255
256
257=head2 promote_encoding STRING [CONTENT-TYPE]
258
259Return STRING promoted to our best-guess of an appropriate
260encoding. STRING should B<not> have the UTF-8 flag set when passed in.
261
262Optionally, you can pass a MIME content-type string as a second
263argument. If it contains a charset= parameter, we will use that
264encoding. Failing that, we use Encode::Guess to guess between UTF-8
265and iso-latin-1. If that fails, and the string validates as UTF-8, we
266assume that. Finally, we fall back on returning the string as is.
267
268=cut
269
270# XXX TODO This possibly needs to be more clever and/or configurable
271
272sub promote_encoding {
273    my $class = shift;
274    my $string = shift;
275    my $content_type = shift;
276    my $charset;
277
278    # Don't bother parsing the Content-Type header unless it mentions "charset".
279    # This is to avoid the "Unquoted / not allowed in Content-Type" warnings when
280    # the Base64-encoded MIME boundary string contains "/".
281    if ($content_type and $content_type =~ /charset/i) {
282        $content_type = Email::MIME::ContentType::parse_content_type($content_type);
283        $charset = $content_type->{attributes}->{charset};
284    }
285
286    # XXX TODO Is this the right thing? Maybe we should just return
287    # the string as-is.
288    Encode::_utf8_off($string);
289
290    if($charset) {
291        $string = Encode::decode($charset, $string);
292    } else {
293        my $encoding = Encode::Guess->guess($string);
294        if(!ref($encoding)) {
295            local $@;
296            eval {
297                # Try utf8
298                $string = Encode::decode_utf8($string, 1);
299            };
300            if($@) {
301                warn "Unknown encoding -- none specified, couldn't guess, not valid UTF-8";
302            }
303        } else {
304            $string = $encoding->decode($string) if $encoding;
305        }
306    }
307
308    return $string;
309}
310
311=head2 maybe_decode_utf8 STRING
312
313Attempt to decode STRING as UTF-8. If STRING is not valid UTF-8, or
314already contains wide characters, return it undecoded.
315
316N.B: In an ideal world, we wouldn't need this function, since we would
317know whether any given piece of input is UTF-8. However, the world is
318not ideal.
319
320=cut
321
322sub maybe_decode_utf8 {
323    my $class = shift;
324    my $string = shift;
325
326    local $@;
327    eval {
328        $string =  Encode::decode_utf8($string);
329    };
330    Carp::carp "Couldn't decode UTF-8: $@" if $@;
331    return $string;
332}
333
334package Jifty::I18N::en;
335use base 'Locale::Maketext';
336our %Lexicon = ( _fallback => 1, _AUTO => 1 );
337
3381;
339