view release on metacpan or  search on metacpan

inc/inc_Locale-Maketext-Simple/Locale/Maketext/Simple.pm  view on Meta::CPAN

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 { 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 {