| Commit | Line | Data |
|---|
| c9d0c046 |
1 | package Locale::Maketext::Simple; |
| 2 | $Locale::Maketext::Simple::VERSION = '0.18'; |
| 3 | |
| 4 | use strict; |
| 5 | use 5.004; |
| 6 | |
| 7 | =head1 NAME |
| 8 | |
| 9 | Locale::Maketext::Simple - Simple interface to Locale::Maketext::Lexicon |
| 10 | |
| 11 | =head1 VERSION |
| 12 | |
| 13 | This document describes version 0.18 of Locale::Maketext::Simple, |
| 14 | released Septermber 8, 2006. |
| 15 | |
| 16 | =head1 SYNOPSIS |
| 17 | |
| 18 | Minimal setup (looks for F<auto/Foo/*.po> and F<auto/Foo/*.mo>): |
| 19 | |
| 20 | package Foo; |
| 21 | use Locale::Maketext::Simple; # exports 'loc' |
| 22 | loc_lang('fr'); # set language to French |
| 23 | sub hello { |
| 24 | print loc("Hello, [_1]!", "World"); |
| 25 | } |
| 26 | |
| 27 | More sophisticated example: |
| 28 | |
| 29 | package Foo::Bar; |
| 30 | use Locale::Maketext::Simple ( |
| 31 | Class => 'Foo', # search in auto/Foo/ |
| 32 | Style => 'gettext', # %1 instead of [_1] |
| 33 | Export => 'maketext', # maketext() instead of loc() |
| 34 | Subclass => 'L10N', # Foo::L10N instead of Foo::I18N |
| 35 | Decode => 1, # decode entries to unicode-strings |
| 36 | Encoding => 'locale', # but encode lexicons in current locale |
| 37 | # (needs Locale::Maketext::Lexicon 0.36) |
| 38 | ); |
| 39 | sub japh { |
| 40 | print maketext("Just another %1 hacker", "Perl"); |
| 41 | } |
| 42 | |
| 43 | =head1 DESCRIPTION |
| 44 | |
| 45 | This module is a simple wrapper around B<Locale::Maketext::Lexicon>, |
| 46 | designed to alleviate the need of creating I<Language Classes> for |
| 47 | module authors. |
| 48 | |
| 49 | If B<Locale::Maketext::Lexicon> is not present, it implements a |
| 50 | minimal localization function by simply interpolating C<[_1]> with |
| 51 | the first argument, C<[_2]> with the second, etc. Interpolated |
| 52 | function like C<[quant,_1]> are treated as C<[_1]>, with the sole |
| 53 | exception of C<[tense,_1,X]>, which will append C<ing> to C<_1> when |
| 54 | X is C<present>, or appending C<ed> to <_1> otherwise. |
| 55 | |
| 56 | =head1 OPTIONS |
| 57 | |
| 58 | All options are passed either via the C<use> statement, or via an |
| 59 | explicit C<import>. |
| 60 | |
| 61 | =head2 Class |
| 62 | |
| 63 | By default, B<Locale::Maketext::Simple> draws its source from the |
| 64 | calling package's F<auto/> directory; you can override this behaviour |
| 65 | by explicitly specifying another package as C<Class>. |
| 66 | |
| 67 | =head2 Path |
| 68 | |
| 69 | If your PO and MO files are under a path elsewhere than C<auto/>, |
| 70 | you may specify it using the C<Path> option. |
| 71 | |
| 72 | =head2 Style |
| 73 | |
| 74 | By default, this module uses the C<maketext> style of C<[_1]> and |
| 75 | C<[quant,_1]> for interpolation. Alternatively, you can specify the |
| 76 | C<gettext> style, which uses C<%1> and C<%quant(%1)> for interpolation. |
| 77 | |
| 78 | This option is case-insensitive. |
| 79 | |
| 80 | =head2 Export |
| 81 | |
| 82 | By default, this module exports a single function, C<loc>, into its |
| 83 | caller's namespace. You can set it to another name, or set it to |
| 84 | an empty string to disable exporting. |
| 85 | |
| 86 | =head2 Subclass |
| 87 | |
| 88 | By default, this module creates an C<::I18N> subclass under the |
| 89 | caller's package (or the package specified by C<Class>), and stores |
| 90 | lexicon data in its subclasses. You can assign a name other than |
| 91 | C<I18N> via this option. |
| 92 | |
| 93 | =head2 Decode |
| 94 | |
| 95 | If set to a true value, source entries will be converted into |
| 96 | utf8-strings (available in Perl 5.6.1 or later). This feature |
| 97 | needs the B<Encode> or B<Encode::compat> module. |
| 98 | |
| 99 | =head2 Encoding |
| 100 | |
| 101 | Specifies an encoding to store lexicon entries, instead of |
| 102 | utf8-strings. If set to C<locale>, the encoding from the current |
| 103 | locale setting is used. Implies a true value for C<Decode>. |
| 104 | |
| 105 | =cut |
| 106 | |
| 107 | sub import { |
| 108 | my ($class, %args) = @_; |
| 109 | |
| 110 | $args{Class} ||= caller; |
| 111 | $args{Style} ||= 'maketext'; |
| 112 | $args{Export} ||= 'loc'; |
| 113 | $args{Subclass} ||= 'I18N'; |
| 114 | |
| 115 | my ($loc, $loc_lang) = $class->load_loc(%args); |
| 116 | $loc ||= $class->default_loc(%args); |
| 117 | |
| 118 | no strict 'refs'; |
| 119 | *{caller(0) . "::$args{Export}"} = $loc if $args{Export}; |
| 120 | *{caller(0) . "::$args{Export}_lang"} = $loc_lang || sub { 1 }; |
| 121 | } |
| 122 | |
| 123 | my %Loc; |
| 124 | |
| 125 | sub reload_loc { %Loc = () } |
| 126 | |
| 127 | sub load_loc { |
| 128 | my ($class, %args) = @_; |
| 129 | |
| 130 | my $pkg = join('::', grep { defined and length } $args{Class}, $args{Subclass}); |
| 131 | return $Loc{$pkg} if exists $Loc{$pkg}; |
| 132 | |
| 133 | eval { require Locale::Maketext::Lexicon; 1 } or return; |
| 134 | $Locale::Maketext::Lexicon::VERSION > 0.20 or return; |
| 135 | eval { require File::Spec; 1 } or return; |
| 136 | |
| 137 | my $path = $args{Path} || $class->auto_path($args{Class}) or return; |
| 138 | my $pattern = File::Spec->catfile($path, '*.[pm]o'); |
| 139 | my $decode = $args{Decode} || 0; |
| 140 | my $encoding = $args{Encoding} || undef; |
| 141 | |
| 142 | $decode = 1 if $encoding; |
| 143 | |
| 144 | $pattern =~ s{\\}{/}g; # to counter win32 paths |
| 145 | |
| 146 | eval " |
| 147 | package $pkg; |
| 148 | use base 'Locale::Maketext'; |
| 149 | %${pkg}::Lexicon = ( '_AUTO' => 1 ); |
| 150 | Locale::Maketext::Lexicon->import({ |
| 151 | 'i-default' => [ 'Auto' ], |
| 152 | '*' => [ Gettext => \$pattern ], |
| 153 | _decode => \$decode, |
| 154 | _encoding => \$encoding, |
| 155 | }); |
| 156 | *tense = sub { \$_[1] . ((\$_[2] eq 'present') ? 'ing' : 'ed') } |
| 157 | unless defined &tense; |
| 158 | |
| 159 | 1; |
| 160 | " or die $@; |
| 161 | |
| 162 | my $lh = eval { $pkg->get_handle } or return; |
| 163 | my $style = lc($args{Style}); |
| 164 | if ($style eq 'maketext') { |
| 165 | $Loc{$pkg} = sub { |
| 166 | $lh->maketext(@_) |
| 167 | }; |
| 168 | } |
| 169 | elsif ($style eq 'gettext') { |
| 170 | $Loc{$pkg} = sub { |
| 171 | my $str = shift; |
| 172 | $str =~ s{([\~\[\]])}{~$1}g; |
| 173 | $str =~ s{ |
| 174 | ([%\\]%) # 1 - escaped sequence |
| 175 | | |
| 176 | % (?: |
| 177 | ([A-Za-z#*]\w*) # 2 - function call |
| 178 | \(([^\)]*)\) # 3 - arguments |
| 179 | | |
| 180 | ([1-9]\d*|\*) # 4 - variable |
| 181 | ) |
| 182 | }{ |
| 183 | $1 ? $1 |
| 184 | : $2 ? "\[$2,"._unescape($3)."]" |
| 185 | : "[_$4]" |
| 186 | }egx; |
| 187 | return $lh->maketext($str, @_); |
| 188 | }; |
| 189 | } |
| 190 | else { |
| 191 | die "Unknown Style: $style"; |
| 192 | } |
| 193 | |
| 194 | return $Loc{$pkg}, sub { |
| 195 | $lh = $pkg->get_handle(@_); |
| 196 | $lh = $pkg->get_handle(@_); |
| 197 | }; |
| 198 | } |
| 199 | |
| 200 | sub default_loc { |
| 201 | my ($self, %args) = @_; |
| 202 | my $style = lc($args{Style}); |
| 203 | if ($style eq 'maketext') { |
| 204 | return sub { |
| 205 | my $str = shift; |
| 206 | $str =~ s{((?<!~)(?:~~)*)\[_([1-9]\d*|\*)\]} |
| 207 | {$1%$2}g; |
| 208 | $str =~ s{((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]} |
| 209 | {"$1%$2(" . _escape($3) . ')'}eg; |
| 210 | _default_gettext($str, @_); |
| 211 | }; |
| 212 | } |
| 213 | elsif ($style eq 'gettext') { |
| 214 | return \&_default_gettext; |
| 215 | } |
| 216 | else { |
| 217 | die "Unknown Style: $style"; |
| 218 | } |
| 219 | } |
| 220 | |
| 221 | sub _default_gettext { |
| 222 | my $str = shift; |
| 223 | $str =~ s{ |
| 224 | % # leading symbol |
| 225 | (?: # either one of |
| 226 | \d+ # a digit, like %1 |
| 227 | | # or |
| 228 | (\w+)\( # a function call -- 1 |
| 229 | (?: # either |
| 230 | %\d+ # an interpolation |
| 231 | | # or |
| 232 | ([^,]*) # some string -- 2 |
| 233 | ) # end either |
| 234 | (?: # maybe followed |
| 235 | , # by a comma |
| 236 | ([^),]*) # and a param -- 3 |
| 237 | )? # end maybe |
| 238 | (?: # maybe followed |
| 239 | , # by another comma |
| 240 | ([^),]*) # and a param -- 4 |
| 241 | )? # end maybe |
| 242 | [^)]* # and other ignorable params |
| 243 | \) # closing function call |
| 244 | ) # closing either one of |
| 245 | }{ |
| 246 | my $digit = $2 || shift; |
| 247 | $digit . ( |
| 248 | $1 ? ( |
| 249 | ($1 eq 'tense') ? (($3 eq 'present') ? 'ing' : 'ed') : |
| 250 | ($1 eq 'quant') ? ' ' . (($digit > 1) ? ($4 || "$3s") : $3) : |
| 251 | '' |
| 252 | ) : '' |
| 253 | ); |
| 254 | }egx; |
| 255 | return $str; |
| 256 | }; |
| 257 | |
| 258 | sub _escape { |
| 259 | my $text = shift; |
| 260 | $text =~ s/\b_([1-9]\d*)/%$1/g; |
| 261 | return $text; |
| 262 | } |
| 263 | |
| 264 | sub _unescape { |
| 265 | join(',', map { |
| 266 | /\A(\s*)%([1-9]\d*|\*)(\s*)\z/ ? "$1_$2$3" : $_ |
| 267 | } split(/,/, $_[0])); |
| 268 | } |
| 269 | |
| 270 | sub auto_path { |
| 271 | my ($self, $calldir) = @_; |
| 272 | $calldir =~ s#::#/#g; |
| 273 | my $path = $INC{$calldir . '.pm'} or return; |
| 274 | |
| 275 | # Try absolute path name. |
| 276 | if ($^O eq 'MacOS') { |
| 277 | (my $malldir = $calldir) =~ tr#/#:#; |
| 278 | $path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:#s; |
| 279 | } else { |
| 280 | $path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/#; |
| 281 | } |
| 282 | |
| 283 | return $path if -d $path; |
| 284 | |
| 285 | # If that failed, try relative path with normal @INC searching. |
| 286 | $path = "auto/$calldir/"; |
| 287 | foreach my $inc (@INC) { |
| 288 | return "$inc/$path" if -d "$inc/$path"; |
| 289 | } |
| 290 | |
| 291 | return; |
| 292 | } |
| 293 | |
| 294 | 1; |
| 295 | |
| 296 | =head1 ACKNOWLEDGMENTS |
| 297 | |
| 298 | Thanks to Jos I. Boumans for suggesting this module to be written. |
| 299 | |
| 300 | Thanks to Chia-Liang Kao for suggesting C<Path> and C<loc_lang>. |
| 301 | |
| 302 | =head1 SEE ALSO |
| 303 | |
| 304 | L<Locale::Maketext>, L<Locale::Maketext::Lexicon> |
| 305 | |
| 306 | =head1 AUTHORS |
| 307 | |
| 308 | Audrey Tang E<lt>cpan@audreyt.orgE<gt> |
| 309 | |
| 310 | =head1 COPYRIGHT |
| 311 | |
| 312 | Copyright 2003, 2004, 2005, 2006 by Audrey Tang E<lt>cpan@audreyt.orgE<gt>. |
| 313 | |
| 314 | This software is released under the MIT license cited below. Additionally, |
| 315 | when this software is distributed with B<Perl Kit, Version 5>, you may also |
| 316 | redistribute it and/or modify it under the same terms as Perl itself. |
| 317 | |
| 318 | =head2 The "MIT" License |
| 319 | |
| 320 | Permission is hereby granted, free of charge, to any person obtaining a copy |
| 321 | of this software and associated documentation files (the "Software"), to deal |
| 322 | in the Software without restriction, including without limitation the rights |
| 323 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell |
| 324 | copies of the Software, and to permit persons to whom the Software is |
| 325 | furnished to do so, subject to the following conditions: |
| 326 | |
| 327 | The above copyright notice and this permission notice shall be included in |
| 328 | all copies or substantial portions of the Software. |
| 329 | |
| 330 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS |
| 331 | OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, |
| 332 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL |
| 333 | THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER |
| 334 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING |
| 335 | FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER |
| 336 | DEALINGS IN THE SOFTWARE. |
| 337 | |
| 338 | =cut |
projects / p5sagit/p5-mst-13.2.git / blame