[Summary view] [Print] [Text view]

   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