File Coverage

blib/lib/I18N/Langinfo/Wide.pm

Criterion	Covered	Total	%
statement	26	29	89.6
branch	2	4	50.0
condition			n/a
subroutine	9	9	100.0
pod	2	2	100.0
total	39	44	88.6

# Copyright 2009, 2010, 2011, 2014 Kevin Ryde

# This file is part of I18N-Langinfo-Wide.
#
# I18N-Langinfo-Wide is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# I18N-Langinfo-Wide is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with I18N-Langinfo-Wide.  If not, see .

package I18N::Langinfo::Wide;
use 5.008001;
use strict;
use warnings;
use I18N::Langinfo ();

# version 2.25 for Encode::Alias recognise "646" on netbsd
use Encode 2.25;

our $VERSION = 9;

use Exporter;
our @ISA = ('Exporter');
our @EXPORT_OK = qw(langinfo to_wide);

# not yet ...
# %EXPORT_TAGS = (all => \@EXPORT_OK);


# As of I18N::Langinfo 0.02 in perl 5.10.1 all the langinfo()s are locale
# character strings.  The binary ones like GROUPING or P_CS_PRECEDES are not
# offered.  (glibc categories.def sets out which is what.)
#
# exists $_byte{$key_integer} means a byte string
our %_byte;
BEGIN {
  @_byte{ # hash slice
    grep {defined}
      map {eval "I18N::Langinfo::$_()"}
        qw(GROUPING
           MON_GROUPING
           FRAC_DIGITS
           INT_FRAC_DIGITS
           P_CS_PRECEDES
           P_SEP_BY_SPACE
           N_CS_PRECEDES
           N_SEP_BY_SPACE
           P_SIGN_POSN
           N_SIGN_POSN
           INT_P_CS_PRECEDES
           INT_P_SEP_BY_SPACE
           INT_N_CS_PRECEDES
           INT_N_SEP_BY_SPACE
           INT_P_SIGN_POSN
           INT_N_SIGN_POSN)
      } = ();
}

sub langinfo {
  my ($key) = @_;
  my $str = I18N::Langinfo::langinfo($key);
  if ($_byte{$key}) {
    return $str;
  } else {
    return to_wide($str);
  }
}

sub to_wide {
  my ($str) = @_;
  if (utf8::is_utf8($str)) { return $str; }

  # netbsd langinfo(CODESET) returns "646" meaning ISO-646, ie. ASCII.  Must
  # put that through resolve_alias() to turn it into "ascii".
  #
  return Encode::decode (Encode::resolve_alias
                         (I18N::Langinfo::langinfo
                          (I18N::Langinfo::CODESET())),
                         $str, Encode::FB_CROAK());
}

1;
__END__