/usr/share/perl5/Term/Encoding.pm is in libterm-encoding-perl 0.02-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 | package Term::Encoding;
use strict;
our $VERSION = '0.02';
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__
=head1 NAME
Term::Encoding - Detect encoding of the current terminal
=head1 SYNOPSIS
use Term::Encoding qw(term_encoding);
my $encoding = term_encoding;
# ditto without exporting function
use Term::Encoding;
my $encoding = Term::Encoding::get_encoding();
=head1 DESCRIPTION
Term::Encoding is a simple module to detect an encoding the current
terminal expects, in various ways.
=head1 AUTHORS
Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
Audrey Tang E<lt>audreyt@audreyt.orgE<gt>
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 SEE ALSO
L<Locale::Maketext::Lexicon>
=cut
|