view release on metacpan or  search on metacpan

lib/Getopt/EX/i18n.pm  view on Meta::CPAN

    }

    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 =~ /^(?<lang>\w\w)_(?<cc>\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__