File Coverage

blib/lib/Term/Encoding.pm

Criterion	Covered	Total	%
statement	25	30	83.3
branch	8	16	50.0
condition	4	6	66.6
subroutine	4	4	100.0
pod	0	1	0.0
total	41	57	71.9

package Term::Encoding;

use strict;
our $VERSION = '0.03';

use base qw(Exporter);
our @EXPORT_OK = qw(term_encoding);

*term_encoding = \&get_encoding;

sub get_encoding {
    no warnings 'uninitialized';

    my($locale, $encoding);
    local $@;

    eval {
        # try I18N::Langinfo to get encoding from system
        require I18N::Langinfo;
        $encoding = I18N::Langinfo::langinfo(I18N::Langinfo::CODESET());
    };

    if ($^O eq 'MSWin32') {
        # if it's running on win32 ... try Win32::Console
        eval {
            require Win32::Console;
            $encoding = 'cp'.Win32::Console::OutputCP();
        };
    };

    # Still no luck ... use environment variables to get locale and encoding
    if (!$encoding) {
        foreach my $key (qw( LANGUAGE LC_ALL LC_MESSAGES LANG )) {
            $ENV{$key} =~ /^([^.]+)\.([^.:]+)/ or next;
            ($locale, $encoding) = ($1, $2);
            last;
        }
    }

    # deal with EUC asian variants
    if (defined $encoding &&
        lc($encoding) eq 'euc' &&
        defined $locale) {
        if ($locale =~ /^ja_JP|japan(?:ese)?$/i) {
            $encoding = 'euc-jp';
        } elsif ($locale =~ /^ko_KR|korean?$/i) {
            $encoding = 'euc-kr';
        } elsif ($locale =~ /^zh_CN|chin(?:a|ese)?$/i) {
            $encoding = 'euc-cn';
        } elsif ($locale =~ /^zh_TW|taiwan(?:ese)?$/i) {
            $encoding = 'euc-tw';
        }
    }

    return lc($encoding);
}

1;
__END__