Change 11236 by jhi@alpha on 2001/07/09 14:10:07
Add a pseudolayer ":locale" to the open pragma which
will get the encoding from the locale. Yet undocumented
because I can't get the PerlIO :encoding(foobar) to work.
Affected files ...
... //depot/perl/ext/Encode/Encode.pm#30 edit
... //depot/perl/lib/open.pm#11 edit
Differences ...
==== //depot/perl/ext/Encode/Encode.pm#30 (text) ====
Index: perl/ext/Encode/Encode.pm
--- perl/ext/Encode/Encode.pm.~1~ Mon Jul 9 08:15:05 2001
+++ perl/ext/Encode/Encode.pm Mon Jul 9 08:15:05 2001
@@ -102,17 +102,14 @@
# Allow variants of iso-8859-1 etc.
define_alias( qr/^iso[-_]?(\d+)[-_](\d+)$/i => '"iso-$1-$2"' );
+# At least HP-UX has these.
+define_alias( qr/^iso8859(\d+)$/i => '"iso-8859-$1"' );
+
# This is a font issue, not an encoding issue.
-# (The currency symbol of the Latin 1 upper half is redefined
-# as the euro symbol.)
+# (The currency symbol of the Latin 1 upper half
+# has been redefined as the euro symbol.)
define_alias( qr/^(.+)\@euro$/i => '"$1"' );
-# Solaris has this as a generic Latin-1 encoding.
-define_alias( qr/^iso_8859_1$/ => 'iso-8859-1' );
-
-# At least HP-UX has these.
-define_alias( qr/^iso8859(\d+)$/i => '"iso-8859-$1"' );
-
# Allow latin-1 style names as well
define_alias( qr/^(?:iso[-_]?)?latin[-_]?(\d+)$/i => '"iso-8859-$latin2iso_num[$1]"'
);
@@ -126,9 +123,15 @@
# At least AIX has IBM-NNN (surprisingly...) instead of cpNNN.
define_alias( qr/^ibm[-_]?(\d\d\d\d?)$/i => '"cp$1"');
-# Standardize on the dashed version.
+# Standardize on the dashed versions.
+define_alias( qr/^utf8$/i => 'utf-8' );
define_alias( qr/^koi8r$/i => 'koi8-r' );
+# TODO: the HP-UX '8' encodings: arabic8 greek8 hebrew8 roman8 turkish8
+# TODO: the Thai Encoding tis620
+# TODO: the Chinese Encoding gb18030
+# TODO: what is the Japanese 'ujis' encoding seen in some Linuxes?
+
# Map white space and _ to '-'
define_alias( qr/^(\S+)[\s_]+(.*)$/i => '"$1-$2"' );
==== //depot/perl/lib/open.pm#11 (text) ====
Index: perl/lib/open.pm
--- perl/lib/open.pm.~1~ Mon Jul 9 08:15:05 2001
+++ perl/lib/open.pm Mon Jul 9 08:15:05 2001
@@ -4,6 +4,33 @@
our $VERSION = '1.01';
+my $locale_encoding;
+
+sub in_locale { $^H & $locale::hint_bits }
+
+sub _get_locale_encoding {
+ unless (defined $locale_encoding) {
+ eval { use I18N::Langinfo qw(langinfo CODESET) };
+ unless ($@) {
+ $locale_encoding = langinfo(CODESET);
+ }
+ if (not $locale_encoding && in_locale()) {
+ if ($ENV{LC_ALL} =~ /^[^.]+\.([^.]+)$/) {
+ $locale_encoding = $1;
+ } elsif ($ENV{LANG} =~ /^[^.]+\.([^.]+)$/) {
+ $locale_encoding = $1;
+ }
+ } else {
+ # Could do heuristics based on the country and language
+ # parts of LC_ALL and LANG (the parts before the dot (if any)),
+ # since we have Locale::Country and Locale::Language available.
+ # TODO: get a database of Language -> Encoding mappings
+ # (the Estonian database would be excellent!)
+ # --jhi
+ }
+ }
+}
+
sub import {
my ($class,@args) = @_;
croak("`use open' needs explicit list of disciplines") unless @args;
@@ -17,6 +44,14 @@
my @val;
foreach my $layer (split(/\s+/,$discp)) {
$layer =~ s/^://;
+ if ($layer eq 'locale') {
+ use Encode;
+ _get_locale_encoding()
+ unless defined $locale_encoding;
+ croak "Cannot figure out an encoding to use"
+ unless defined $locale_encoding;
+ $layer = "encoding($locale_encoding)";
+ }
unless(PerlIO::Layer::->find($layer)) {
carp("Unknown discipline layer '$layer'");
}
End of Patch.
