File Coverage

blib/lib/Getopt/EX/i18n.pm

Criterion	Covered	Total	%
statement	36	96	37.5
branch	7	50	14.0
condition	3	18	16.6
subroutine	15	19	78.9
pod	0	7	0.0
total	61	190	32.1

use v5.14;
package Getopt::EX::i18n;

our $VERSION = '1.02';

use warnings;
use Data::Dumper;

=encoding utf-8

=head1 NAME

Getopt::EX::i18n - General i18n module

=head1 SYNOPSIS

command -Mi18n [ options ]

=head1 DESCRIPTION

This module B provides an easy way to set locale environment
before executing arbitrary command.  Locale list is taken from the
system by C command.  The following list shows sample locales
available on macOS 10.15 (Catalina).

    af_ZA    Afrikaans / South Africa
    am_ET    Amharic / Ethiopia
    be_BY    Belarusian / Belarus
    bg_BG    Bulgarian / Bulgaria
    ca_ES    Catalan; Valencian / Spain
    cs_CZ    Czech / Czech Republic
    da_DK    Danish / Denmark
    de_AT    German / Austria
    de_CH    German / Switzerland
    de_DE    German / Germany
    el_GR    Greek, Modern (1453-) / Greece
    en_AU    English / Australia
    en_CA    English / Canada
    en_GB    English / United Kingdom
    en_IE    English / Ireland
    en_NZ    English / New Zealand
    en_US    English / United States
    es_ES    Spanish / Spain
    et_EE    Estonian / Estonia
    eu_ES    Basque / Spain
    fi_FI    Finnish / Finland
    fr_BE    French / Belgium
    fr_CA    French / Canada
    fr_CH    French / Switzerland
    fr_FR    French / France
    he_IL    Hebrew / Israel
    hr_HR    Croatian / Croatia
    hu_HU    Hungarian / Hungary
    hy_AM    Armenian / Armenia
    is_IS    Icelandic / Iceland
    it_CH    Italian / Switzerland
    it_IT    Italian / Italy
    ja_JP    Japanese / Japan
    kk_KZ    Kazakh / Kazakhstan
    ko_KR    Korean / Korea, Republic of
    lt_LT    Lithuanian / Lithuania
    nl_BE    Dutch / Belgium
    nl_NL    Dutch / Netherlands
    no_NO    Norwegian / Norway
    pl_PL    Polish / Poland
    pt_BR    Portuguese / Brazil
    pt_PT    Portuguese / Portugal
    ro_RO    Romanian / Romania
    ru_RU    Russian / Russian Federation
    sk_SK    Slovak / Slovakia
    sl_SI    Slovenian / Slovenia
    sr_YU    Serbian / Yugoslavia
    sv_SE    Swedish / Sweden
    tr_TR    Turkish / Turkey
    uk_UA    Ukrainian / Ukraine
    zh_CN    Chinese / China
    zh_HK    Chinese / Hong Kong
    zh_TW    Chinese / Taiwan, Province of China

For Japanese locale C, the following options are defined by
default, and set C environment to C.  The environment
variable name can be changed by B option.

    LOCALE:     --ja_JP  (raw)
                --ja-JP  (dash)
                --jaJP   (long)
                --jajp   (long_lc)
    LANGUAGE:   --ja     (language)
    TERRITORY:  --JP     (territory)
                --jp     (territory_lc)

Short language option (C<--ja>) is defined in alphabetical order
of the territory code, so the option C<--en> is assigned to C.
However, if the same territory name is found as language, it takes
precedence; German is used in three locales (C, C,
C) but option C<--de> is defined as C.

Territory options (C<--JP> and C<--jp>) are defined only when the same
language option is not defined by other entry, and only a single entry
can be found for the territory.  Options for Switzerland are not defined
because there are three entries (C, C, C).
Territory option C<--AM> is assigned to C, but language option
C<--am> is assigned to C.

=head1 OPTION

Option parameter can be given with B function called with
module declaration.

    command -Mi18n::setopt(name[=value])

=over 7

=item B

=item B

=item B

=item B

=item B

=item B

=item B

These parameters tell which options are defined.  All options are
enabled by default.  You can disable territory options like this:

    command -Mi18n::setopt(territory=0,territory_lc=0)

    command -Mi18n::setopt=territory=0,territory_lc=0

=item B

Show locale information.

    $ optex -Mi18n::setopt=verbose date --it
    LANG=it_IT (Italian / Italy)
    Gio  4 Giu 2020 16:47:33 JST

=item B

Show option list.

=item B=I

Set the option to display the option list and exit.  You can introduce a
new option B<-l> to show the available option list:

    -Mi18n::setopt(listopt=-l)

=item B=I

Specify prefix string.  Default is C<-->.

=item B=I

Specify environment variable name to be set.  Default is C.

=back

=head1 DEPENDENCIES

This module uses L and L
to provide language and country names for locale codes.

=head1 BUGS

Support only UTF-8.

=head1 SEE ALSO

=over 7

=item L

L

=item L

You can execute arbitrary command on the system getting the benefit of
B using B.

    $ optex -Mi18n cal 2020 --am

L

L

=back

=head1 LICENSE

Copyright (C) 2020-2025 Kazumasa Utashiro.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHOR

Kazumasa Utashiro

=cut

my %opt = (
    env          => 'LANG',
    raw          => 1,
    dash         => 1,
    long         => 1,
    long_lc      => 1,
    language     => 1,
    territory    => 1,
    territory_lc => 1,
    verbose      => 0,
    list         => 0,
    prefix       => '--',
    listopt      => undef,
    );

my $module;

sub initialize {
    return if state $called++;
    my($obj, $argv) = @_;
    $module = $obj;
    setup();
}

my @locale;
my %locale;
my %lang;
my %cc;
my %opthash;

package #
Local::LocaleObj {
    sub new {
	my($class, %hash) = @_;
	bless \%hash, $class;
    }
    sub name { $_[0]->{name} // '' }
    sub lang { $_[0]->{lang} // '' }
    sub cc   { $_[0]->{cc}   // '' }
    sub create {
	(my $class, local $_) = @_;
	/^(?(?[a-z][a-z])_(?[A-Z][A-Z]))/ or die;
	$class->new(%+);
    }

    use Locale::Codes::Language;
    sub lang_name { code2language(+shift->lang) || 'UNKNOWN' }

    use Locale::Codes::Country;
    sub cc_name   { code2country(+shift->cc)   || 'UNKNOWN' }
}

sub finalize {
    my($obj, $argv) = @_;
    for my $locale (sort @locale) {
	$locale =~ /^(?\w\w)_(?\w\w)$/ or next;
	my($lang, $cc) = @+{qw(lang cc)};;
	my @list;
	push @list, "$locale"   if $opt{raw};
	push @list, "$lang-$cc" if $opt{dash};
	push @list, "$lang$cc"  if $opt{long};
	$cc = lc $cc;
	push @list, "$lang$cc"  if $opt{long_lc};
	if ($opt{language}) {
	    if (!$opthash{$lang} or $lang eq $cc) {
		push @list, $lang;
	    }
	}
	if ($lang eq $cc or @{$cc{$cc}} == 1) {
	    push @list, uc $cc if $opt{territory};
	    push @list,    $cc if $opt{territory_lc} and !$lang{$cc};
	}
	for (@list) {
	    $opthash{$_} = Local::LocaleObj->create($locale);
	}
    }

    $obj->mode(function => 1);
    if (my $listopt = $opt{listopt}) {
	$obj->setopt($listopt, "&options(show,exit)");
    }
    &options(set => 1, show => $opt{list});
    return;
}

sub options {
    my %arg = (
	set  => 0, # set option
	show => 0, # print option
	exit => 0, # exit at the end
	@_);
    my @keys = do {
	map  { $_->[0] }
	sort { $a->[1] cmp $b->[1] ||
	       lc $a->[0] cmp lc $b->[0] || $a->[0] cmp $b->[0] }
	map  { [ $_, $opthash{$_}->cc ] }
	keys %opthash;
    };
    for my $opt (@keys) {
	my $obj = $opthash{$opt};
	my $option = $opt{prefix} . $opt;
	my $name = $obj->name;
	my $locale = $locale{$name};
	my $call = "&setenv($opt{env}=$locale)";
	$module->setopt($option, $call) if $arg{set};
	if ($arg{show}) {
	    printf "option %-*s %s # %s / %s\n",
		(state $optwidth = length($opt{prefix}) + length($name)),
		$option, $call,
		$obj->cc_name, $obj->lang_name;
	}
    }
    exit if $arg{exit};
    return ();
}

sub setup {
    return if state $called++;
    grep { -x "$_/locale" } split /:/, $ENV{PATH} or return;
    for (`locale -a`) {
	chomp;
	/^(([a-z][a-z])_([A-Z][A-Z]))(?=(?i:$|\.utf))/ or next;
	my($name, $lang, $cc) = ($1, $2, lc $3);
	if (my $last = $locale{$name}) {
	    $locale{$name} = $_ if length($_) < length($last);
	    next;
	}
	$locale{$name} = $_;
	push @locale,           $name;
	push @{ $lang{$lang} }, $name;
	push @{ $cc{$cc}     }, $name;
    }
}

sub locales {
    chomp( my @locale = `locale -a` );
    grep { /^\w\w_\w\w$/ } @locale;
}

sub setopt {
    %opt = (%opt, @_);
}

sub setenv {
    while (@_ >= 2) {
	my($key, $value) = splice @_, 0, 2;
	if ($opt{verbose}) {
	    my $l = Local::LocaleObj->create($value);
	    warn sprintf("%s=%s (%s / %s)\n",
			 $key, $value, $l->lang_name, $l->cc_name);
	}
	$ENV{$key} = $value;
    }
    return ();
}

1;

__DATA__