view release on metacpan or  search on metacpan

lib/CGI/Kwiki/I18N.pm  view on Meta::CPAN

package CGI::Kwiki::I18N;
use strict;
use vars '@ISA';

my $init;
sub initialize {
    my ($self, $use_utf8) = @_;
    return if $init++;

    eval { require Locale::Maketext; 1 } or return;
    @ISA = ('Locale::Maketext');

    $self->_import(
        Class  => 'CGI::Kwiki',
        Style  => 'gettext',
        Export => 'gettext',
        Path   => substr(__FILE__, 0, -3),
        Decode => 1,
        Fail   => !$use_utf8,
    );
}

sub loc {
    my $self = shift;
    $self->initialize($] >= 5.008);
    gettext_lang();
    return gettext(@_);
}

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 load_loc {
    my ($class, %args) = @_;
    return if $args{Fail};

    my $pkg = join('::', $args{Class}, $args{Subclass});
    return $Loc{$pkg} if exists $Loc{$pkg};

    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;

    $pattern =~ s{\\}{/}g; # to counter win32 paths

    eval "
	package $pkg;
	use base 'Locale::Maketext';
        %${pkg}::Lexicon = ( '_AUTO' => 1 );
	CGI::Kwiki::I18N::Lexicon->import({
	    '*'	=> [ Gettext => \$pattern ],
	    _decode => \$decode,
	});

	1;
    " or die $@;
    
    my $lh = eval { $pkg->get_handle } or return;
    my $style = lc($args{Style});
    if ($style eq 'maketext') {
	$Loc{$pkg} = $lh->can('maketext');
    }
    elsif ($style eq 'gettext') {
	$Loc{$pkg} = sub {
	    my $str = shift;
	    $str =~ s/[\~\[\]]/~$&/g;
	    $str =~ s{(^|[^%\\])%([A-Za-z#*]\w*)\(([^\)]*)\)}
		     {"$1\[$2,"._unescape($3)."]"}eg;
	    $str =~ s/(^|[^%\\])%(\d+|\*)/$1\[_$2]/g;
	    return $lh->maketext($str, @_);
	};
    }
    else {
	die "Unknown Style: $style";
    }

    return $Loc{$pkg}, sub {
	$lh = $pkg->get_handle(@_);
	$lh = $pkg->get_handle(@_);
    };
}

sub default_loc {
    my ($self, %args) = @_;
    my $style = lc($args{Style});
    if ($style eq 'maketext') {
	return sub {
	    my $str = shift;