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