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


line stmt bran cond sub pod time code
1             # Copyright 2009, 2010, 2011, 2014 Kevin Ryde
2              
3             # This file is part of I18N-Langinfo-Wide.
4             #
5             # I18N-Langinfo-Wide is free software; you can redistribute it and/or modify
6             # it under the terms of the GNU General Public License as published by the
7             # Free Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # I18N-Langinfo-Wide is distributed in the hope that it will be useful, but
11             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with I18N-Langinfo-Wide. If not, see .
17              
18             package I18N::Langinfo::Wide;
19 1     1   497 use 5.008001;
  1         2  
20 1     1   4 use strict;
  1         2  
  1         15  
21 1     1   4 use warnings;
  1         1  
  1         21  
22 1     1   378 use I18N::Langinfo ();
  1         488  
  1         25  
23              
24             # version 2.25 for Encode::Alias recognise "646" on netbsd
25 1     1   463 use Encode 2.25;
  1         8276  
  1         63  
26              
27             our $VERSION = 9;
28              
29 1     1   6 use Exporter;
  1         1  
  1         90  
30             our @ISA = ('Exporter');
31             our @EXPORT_OK = qw(langinfo to_wide);
32              
33             # not yet ...
34             # %EXPORT_TAGS = (all => \@EXPORT_OK);
35              
36              
37             # As of I18N::Langinfo 0.02 in perl 5.10.1 all the langinfo()s are locale
38             # character strings. The binary ones like GROUPING or P_CS_PRECEDES are not
39             # offered. (glibc categories.def sets out which is what.)
40             #
41             # exists $_byte{$key_integer} means a byte string
42             our %_byte;
43             BEGIN {
44             @_byte{ # hash slice
45 0         0 grep {defined}
46 1     1   3 map {eval "I18N::Langinfo::$_()"}
  16         526  
47             qw(GROUPING
48             MON_GROUPING
49             FRAC_DIGITS
50             INT_FRAC_DIGITS
51             P_CS_PRECEDES
52             P_SEP_BY_SPACE
53             N_CS_PRECEDES
54             N_SEP_BY_SPACE
55             P_SIGN_POSN
56             N_SIGN_POSN
57             INT_P_CS_PRECEDES
58             INT_P_SEP_BY_SPACE
59             INT_N_CS_PRECEDES
60             INT_N_SEP_BY_SPACE
61             INT_P_SIGN_POSN
62             INT_N_SIGN_POSN)
63             } = ();
64             }
65              
66             sub langinfo {
67 57     57 1 6254 my ($key) = @_;
68 57         106 my $str = I18N::Langinfo::langinfo($key);
69 57 50       96 if ($_byte{$key}) {
70 0         0 return $str;
71             } else {
72 57         67 return to_wide($str);
73             }
74             }
75              
76             sub to_wide {
77 57     57 1 76 my ($str) = @_;
78 57 50       107 if (utf8::is_utf8($str)) { return $str; }
  0         0  
79              
80             # netbsd langinfo(CODESET) returns "646" meaning ISO-646, ie. ASCII. Must
81             # put that through resolve_alias() to turn it into "ascii".
82             #
83 57         107 return Encode::decode (Encode::resolve_alias
84             (I18N::Langinfo::langinfo
85             (I18N::Langinfo::CODESET())),
86             $str, Encode::FB_CROAK());
87             }
88              
89             1;
90             __END__