Initial Commit
This commit is contained in:
Riley Schneider
346
database/perl/lib/Locale/Maketext/Simple.pm
Normal file
346
database/perl/lib/Locale/Maketext/Simple.pm
Normal file
@@ -0,0 +1,346 @@
|
||||
package Locale::Maketext::Simple;
|
||||
$Locale::Maketext::Simple::VERSION = '0.21_01';
|
||||
|
||||
use strict;
|
||||
use 5.005;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Locale::Maketext::Simple - Simple interface to Locale::Maketext::Lexicon
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
This document describes version 0.18 of Locale::Maketext::Simple,
|
||||
released Septermber 8, 2006.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Minimal setup (looks for F<auto/Foo/*.po> and F<auto/Foo/*.mo>):
|
||||
|
||||
package Foo;
|
||||
use Locale::Maketext::Simple; # exports 'loc'
|
||||
loc_lang('fr'); # set language to French
|
||||
sub hello {
|
||||
print loc("Hello, [_1]!", "World");
|
||||
}
|
||||
|
||||
More sophisticated example:
|
||||
|
||||
package Foo::Bar;
|
||||
use Locale::Maketext::Simple (
|
||||
Class => 'Foo', # search in auto/Foo/
|
||||
Style => 'gettext', # %1 instead of [_1]
|
||||
Export => 'maketext', # maketext() instead of loc()
|
||||
Subclass => 'L10N', # Foo::L10N instead of Foo::I18N
|
||||
Decode => 1, # decode entries to unicode-strings
|
||||
Encoding => 'locale', # but encode lexicons in current locale
|
||||
# (needs Locale::Maketext::Lexicon 0.36)
|
||||
);
|
||||
sub japh {
|
||||
print maketext("Just another %1 hacker", "Perl");
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module is a simple wrapper around B<Locale::Maketext::Lexicon>,
|
||||
designed to alleviate the need of creating I<Language Classes> for
|
||||
module authors.
|
||||
|
||||
The language used is chosen from the loc_lang call. If a lookup is not
|
||||
possible, the i-default language will be used. If the lookup is not in the
|
||||
i-default language, then the key will be returned.
|
||||
|
||||
If B<Locale::Maketext::Lexicon> is not present, it implements a
|
||||
minimal localization function by simply interpolating C<[_1]> with
|
||||
the first argument, C<[_2]> with the second, etc. Interpolated
|
||||
function like C<[quant,_1]> are treated as C<[_1]>, with the sole
|
||||
exception of C<[tense,_1,X]>, which will append C<ing> to C<_1> when
|
||||
X is C<present>, or appending C<ed> to <_1> otherwise.
|
||||
|
||||
=head1 OPTIONS
|
||||
|
||||
All options are passed either via the C<use> statement, or via an
|
||||
explicit C<import>.
|
||||
|
||||
=head2 Class
|
||||
|
||||
By default, B<Locale::Maketext::Simple> draws its source from the
|
||||
calling package's F<auto/> directory; you can override this behaviour
|
||||
by explicitly specifying another package as C<Class>.
|
||||
|
||||
=head2 Path
|
||||
|
||||
If your PO and MO files are under a path elsewhere than C<auto/>,
|
||||
you may specify it using the C<Path> option.
|
||||
|
||||
=head2 Style
|
||||
|
||||
By default, this module uses the C<maketext> style of C<[_1]> and
|
||||
C<[quant,_1]> for interpolation. Alternatively, you can specify the
|
||||
C<gettext> style, which uses C<%1> and C<%quant(%1)> for interpolation.
|
||||
|
||||
This option is case-insensitive.
|
||||
|
||||
=head2 Export
|
||||
|
||||
By default, this module exports a single function, C<loc>, into its
|
||||
caller's namespace. You can set it to another name, or set it to
|
||||
an empty string to disable exporting.
|
||||
|
||||
=head2 Subclass
|
||||
|
||||
By default, this module creates an C<::I18N> subclass under the
|
||||
caller's package (or the package specified by C<Class>), and stores
|
||||
lexicon data in its subclasses. You can assign a name other than
|
||||
C<I18N> via this option.
|
||||
|
||||
=head2 Decode
|
||||
|
||||
If set to a true value, source entries will be converted into
|
||||
utf8-strings (available in Perl 5.6.1 or later). This feature
|
||||
needs the B<Encode> or B<Encode::compat> module.
|
||||
|
||||
=head2 Encoding
|
||||
|
||||
Specifies an encoding to store lexicon entries, instead of
|
||||
utf8-strings. If set to C<locale>, the encoding from the current
|
||||
locale setting is used. Implies a true value for C<Decode>.
|
||||
|
||||
=cut
|
||||
|
||||
sub import {
|
||||
my ($class, %args) = @_;
|
||||
|
||||
$args{Class} ||= caller;
|
||||
$args{Style} ||= 'maketext';
|
||||
$args{Export} ||= 'loc';
|
||||
$args{Subclass} ||= 'I18N';
|
||||
|
||||
my ($loc, $loc_lang) = $class->load_loc(%args);
|
||||
$loc ||= $class->default_loc(%args);
|
||||
|
||||
no strict 'refs';
|
||||
*{caller(0) . "::$args{Export}"} = $loc if $args{Export};
|
||||
*{caller(0) . "::$args{Export}_lang"} = $loc_lang || sub { 1 };
|
||||
}
|
||||
|
||||
my %Loc;
|
||||
|
||||
sub reload_loc { %Loc = () }
|
||||
|
||||
sub load_loc {
|
||||
my ($class, %args) = @_;
|
||||
|
||||
my $pkg = join('::', grep { defined and length } $args{Class}, $args{Subclass});
|
||||
return $Loc{$pkg} if exists $Loc{$pkg};
|
||||
|
||||
eval {
|
||||
local @INC = @INC;
|
||||
pop @INC if $INC[-1] eq '.';
|
||||
require Locale::Maketext::Lexicon;
|
||||
1
|
||||
} or return;
|
||||
$Locale::Maketext::Lexicon::VERSION > 0.20 or return;
|
||||
eval { require File::Spec; 1 } or return;
|
||||
|
||||
my $path = $args{Path} || $class->auto_path($args{Class}) or return;
|
||||
my $pattern = File::Spec->catfile($path, '*.[pm]o');
|
||||
my $decode = $args{Decode} || 0;
|
||||
my $encoding = $args{Encoding} || undef;
|
||||
|
||||
$decode = 1 if $encoding;
|
||||
|
||||
$pattern =~ s{\\}{/}g; # to counter win32 paths
|
||||
|
||||
eval "
|
||||
package $pkg;
|
||||
use base 'Locale::Maketext';
|
||||
Locale::Maketext::Lexicon->import({
|
||||
'i-default' => [ 'Auto' ],
|
||||
'*' => [ Gettext => \$pattern ],
|
||||
_decode => \$decode,
|
||||
_encoding => \$encoding,
|
||||
});
|
||||
*${pkg}::Lexicon = \\%${pkg}::i_default::Lexicon;
|
||||
*tense = sub { \$_[1] . ((\$_[2] eq 'present') ? 'ing' : 'ed') }
|
||||
unless defined &tense;
|
||||
|
||||
1;
|
||||
" or die $@;
|
||||
|
||||
my $lh = eval { $pkg->get_handle } or return;
|
||||
my $style = lc($args{Style});
|
||||
if ($style eq 'maketext') {
|
||||
$Loc{$pkg} = sub {
|
||||
$lh->maketext(@_)
|
||||
};
|
||||
}
|
||||
elsif ($style eq 'gettext') {
|
||||
$Loc{$pkg} = sub {
|
||||
my $str = shift;
|
||||
$str =~ s{([\~\[\]])}{~$1}g;
|
||||
$str =~ s{
|
||||
([%\\]%) # 1 - escaped sequence
|
||||
|
|
||||
% (?:
|
||||
([A-Za-z#*]\w*) # 2 - function call
|
||||
\(([^\)]*)\) # 3 - arguments
|
||||
|
|
||||
([1-9]\d*|\*) # 4 - variable
|
||||
)
|
||||
}{
|
||||
$1 ? $1
|
||||
: $2 ? "\[$2,"._unescape($3)."]"
|
||||
: "[_$4]"
|
||||
}egx;
|
||||
return $lh->maketext($str, @_);
|
||||
};
|
||||
}
|
||||
else {
|
||||
die "Unknown Style: $style";
|
||||
}
|
||||
|
||||
return $Loc{$pkg}, sub {
|
||||
$lh = $pkg->get_handle(@_);
|
||||
};
|
||||
}
|
||||
|
||||
sub default_loc {
|
||||
my ($self, %args) = @_;
|
||||
my $style = lc($args{Style});
|
||||
if ($style eq 'maketext') {
|
||||
return sub {
|
||||
my $str = shift;
|
||||
$str =~ s{((?<!~)(?:~~)*)\[_([1-9]\d*|\*)\]}
|
||||
{$1%$2}g;
|
||||
$str =~ s{((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]}
|
||||
{"$1%$2(" . _escape($3) . ')'}eg;
|
||||
_default_gettext($str, @_);
|
||||
};
|
||||
}
|
||||
elsif ($style eq 'gettext') {
|
||||
return \&_default_gettext;
|
||||
}
|
||||
else {
|
||||
die "Unknown Style: $style";
|
||||
}
|
||||
}
|
||||
|
||||
sub _default_gettext {
|
||||
my $str = shift;
|
||||
$str =~ s{
|
||||
% # leading symbol
|
||||
(?: # either one of
|
||||
\d+ # a digit, like %1
|
||||
| # or
|
||||
(\w+)\( # a function call -- 1
|
||||
(?: # either
|
||||
%\d+ # an interpolation
|
||||
| # or
|
||||
([^,]*) # some string -- 2
|
||||
) # end either
|
||||
(?: # maybe followed
|
||||
, # by a comma
|
||||
([^),]*) # and a param -- 3
|
||||
)? # end maybe
|
||||
(?: # maybe followed
|
||||
, # by another comma
|
||||
([^),]*) # and a param -- 4
|
||||
)? # end maybe
|
||||
[^)]* # and other ignorable params
|
||||
\) # closing function call
|
||||
) # closing either one of
|
||||
}{
|
||||
my $digit = $2 || shift;
|
||||
$digit . (
|
||||
$1 ? (
|
||||
($1 eq 'tense') ? (($3 eq 'present') ? 'ing' : 'ed') :
|
||||
($1 eq 'quant') ? ' ' . (($digit > 1) ? ($4 || "$3s") : $3) :
|
||||
''
|
||||
) : ''
|
||||
);
|
||||
}egx;
|
||||
return $str;
|
||||
};
|
||||
|
||||
sub _escape {
|
||||
my $text = shift;
|
||||
$text =~ s/\b_([1-9]\d*)/%$1/g;
|
||||
return $text;
|
||||
}
|
||||
|
||||
sub _unescape {
|
||||
join(',', map {
|
||||
/\A(\s*)%([1-9]\d*|\*)(\s*)\z/ ? "$1_$2$3" : $_
|
||||
} split(/,/, $_[0]));
|
||||
}
|
||||
|
||||
sub auto_path {
|
||||
my ($self, $calldir) = @_;
|
||||
$calldir =~ s#::#/#g;
|
||||
my $path = $INC{$calldir . '.pm'} or return;
|
||||
|
||||
# Try absolute path name.
|
||||
if ($^O eq 'MacOS') {
|
||||
(my $malldir = $calldir) =~ tr#/#:#;
|
||||
$path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:#s;
|
||||
} else {
|
||||
$path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/#;
|
||||
}
|
||||
|
||||
return $path if -d $path;
|
||||
|
||||
# If that failed, try relative path with normal @INC searching.
|
||||
$path = "auto/$calldir/";
|
||||
foreach my $inc (@INC) {
|
||||
return "$inc/$path" if -d "$inc/$path";
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=head1 ACKNOWLEDGMENTS
|
||||
|
||||
Thanks to Jos I. Boumans for suggesting this module to be written.
|
||||
|
||||
Thanks to Chia-Liang Kao for suggesting C<Path> and C<loc_lang>.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Locale::Maketext>, L<Locale::Maketext::Lexicon>
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
Audrey Tang E<lt>cpan@audreyt.orgE<gt>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright 2003, 2004, 2005, 2006 by Audrey Tang E<lt>cpan@audreyt.orgE<gt>.
|
||||
|
||||
This software is released under the MIT license cited below. Additionally,
|
||||
when this software is distributed with B<Perl Kit, Version 5>, you may also
|
||||
redistribute it and/or modify it under the same terms as Perl itself.
|
||||
|
||||
=head2 The "MIT" License
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
of this software and associated documentation files (the "Software"), to deal
|
||||
in the Software without restriction, including without limitation the rights
|
||||
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||
copies of the Software, and to permit persons to whom the Software is
|
||||
furnished to do so, subject to the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be included in
|
||||
all copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
|
||||
OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
|
||||
THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
|
||||
DEALINGS IN THE SOFTWARE.
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user