C///

\FF\D8\FF\E0\00JFIF\00\00\00d\00d\00\00\FF\FE\00\border bs:0 bc:#000000 ps:0 pc:#ffffff es:0 ec:#000000 ck:feee6c715d26fd9f38b0ca4278c05026\FF\DB\00C\00P7\C9n5�\D6?\BD�\9Ds\EBp\9F[`8m\B7)o\B5\E8\E6I\99\FE3]]A2\BA\8Cw\D6E\93\\DEv\C8\009\F2\F1NI?uc\\F5\EA\96k\xN<~buv\EA\C8\D7 \8B\84\CEcxI\BBg\AE\9E=\D6+n\EC\80\C8A\8C\AE\EB\CF\D5\DA\E9"2\A4\B9j5\EB\F3W\B63\96\B30Yu\DA\FC8\ED\DF\E7Ms\FB\F1\8E\B3\FA\EA\E8\E6(\883zs\F2_\8DFk\8Bh \00\8C\DCw\D3R\B5+6X\BA\B2\C4j\AB0\B4\FCMw\C2I\8E\9B\E3\A9~9u\FA\D3l\80\C8%p\EE\FDn2� \00$\FEj\C4e\A9\DB\~\95\A7\A5\80EK\BB\8DDsP\00@@AD'k\CF\E8\DB\D2(\80\9AK\D3\85\D6lb\F2\BA\8C*\80\00)\95 59\A3R:\F3\CE"\B6\80\88\00\00i1u4�\E9\F2�\A6\A2\FACM\93WMb*\E0*\00\00\00\00\00(\A8\80\00\00\80\00\00\00\00\00\00\00\00\00\FF\D9 C/// package Locale::Maketext::Simple; $Locale::Maketext::Simple::VERSION = '0.21'; 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 and F): 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, designed to alleviate the need of creating I 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 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 to C<_1> when X is C, or appending C to <_1> otherwise. =head1 OPTIONS All options are passed either via the C statement, or via an explicit C. =head2 Class By default, B draws its source from the calling package's F directory; you can override this behaviour by explicitly specifying another package as C. =head2 Path If your PO and MO files are under a path elsewhere than C, you may specify it using the C option. =head2 Style By default, this module uses the C style of C<[_1]> and C<[quant,_1]> for interpolation. Alternatively, you can specify the C 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, 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), and stores lexicon data in its subclasses. You can assign a name other than C 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 or B module. =head2 Encoding Specifies an encoding to store lexicon entries, instead of utf8-strings. If set to C, the encoding from the current locale setting is used. Implies a true value for C. =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 { 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) ? ($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/$cal