X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fopen.pm;h=a6b4250e325d1813c4105bc970d5e543c0443b9e;hb=9915814ae2fdb84b23ea0d5e658a8e037cda2031;hp=35d33dd32390beb5a37a179fc4a8e391186b0170;hpb=7c0e976d40017a166598b7de52585069637d2764;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/open.pm b/lib/open.pm index 35d33dd..a6b4250 100644 --- a/lib/open.pm +++ b/lib/open.pm @@ -1,22 +1,21 @@ package open; use warnings; -use Carp; -$open::hint_bits = 0x20000; # HINT_LOCALIZE_HH -our $VERSION = '1.04'; +our $VERSION = '1.07'; require 5.008001; # for PerlIO::get_layers() -use Encode qw(resolve_alias); - -use encoding ':_get_locale_encoding'; -my $locale_encoding = _get_locale_encoding(); +my $locale_encoding; sub _get_encname { - return ($1, resolve_alias($1)) if $_[0] =~ /^:?encoding\((.+)\)$/; + return ($1, Encode::resolve_alias($1)) if $_[0] =~ /^:?encoding\((.+)\)$/; return; } +sub croak { + require Carp; goto &Carp::croak; +} + sub _drop_oldenc { # If by the time we arrive here there already is at the top of the # perlio layer stack an encoding identical to what we would like @@ -37,17 +36,16 @@ sub _drop_oldenc { return unless @new >= 1 && $new[-1] =~ /^:encoding\(.+\)$/; my @old = PerlIO::get_layers($h); return unless @old >= 3 && - $old[-1] eq 'utf8'; + $old[-1] eq 'utf8' && $old[-2] =~ /^encoding\(.+\)$/; + require Encode; my ($loname, $lcname) = _get_encname($old[-2]); unless (defined $lcname) { # Should we trust get_layers()? - require Carp; - Carp::croak("open: Unknown encoding '$loname'"); + croak("open: Unknown encoding '$loname'"); } my ($voname, $vcname) = _get_encname($new[-1]); unless (defined $vcname) { - require Carp; - Carp::croak("open: Unknown encoding '$voname'"); + croak("open: Unknown encoding '$voname'"); } if ($lcname eq $vcname) { binmode($h, ":pop"); # utf8 is part of the encoding layer @@ -58,7 +56,6 @@ sub import { my ($class,@args) = @_; croak("open: needs explicit list of PerlIO layers") unless @args; my $std; - $^H |= $open::hint_bits; my ($in,$out) = split(/\0/,(${^OPEN} || "\0"), -1); while (@args) { my $type = shift(@args); @@ -77,15 +74,12 @@ sub import { $layer =~ s/^://; if ($layer eq 'locale') { require Encode; - $locale_encoding = _get_locale_encoding() + require encoding; + $locale_encoding = encoding::_get_locale_encoding() unless defined $locale_encoding; (warnings::warnif("layer", "Cannot figure out an encoding to use"), last) unless defined $locale_encoding; - if ($locale_encoding =~ /^utf-?8$/i) { - $layer = "utf8"; - } else { - $layer = "encoding($locale_encoding)"; - } + $layer = "encoding($locale_encoding)"; $std = 1; } else { my $target = $layer; # the layer name itself @@ -153,7 +147,7 @@ open - perl pragma to set default PerlIO layers for input and output use open IO => ':locale'; - use open ':utf8'; + use open ':encoding(utf8)'; use open ':locale'; use open ':encoding(iso-8859-7)'; @@ -169,9 +163,8 @@ The C pragma serves as one of the interfaces to declare default "layers" (also known as "disciplines") for all I/O. Any two-argument open(), readpipe() (aka qx//) and similar operators found within the lexical scope of this pragma will use the declared defaults. -Three-argument opens are not affected by this pragma since there you -(can) explicitly specify the layers and are supposed to know what you -are doing. +Even three-argument opens may be affected by this pragma +when they don't specify IO layers in MODE. With the C subpragma you can declare the default layers of input streams, and with the C subpragma you can declare @@ -180,7 +173,7 @@ you can control both input and output streams simultaneously. If you have a legacy encoding, you can use the C<:encoding(...)> tag. -if you want to set your encoding layers based on your +If you want to set your encoding layers based on your locale environment variables, you can use the C<:locale> tag. For example: @@ -196,8 +189,8 @@ For example: These are equivalent - use open ':utf8'; - use open IO => ':utf8'; + use open ':encoding(utf8)'; + use open IO => ':encoding(utf8)'; as are these @@ -213,23 +206,20 @@ The matching of encoding names is loose: case does not matter, and many encodings have several aliases. See L for details and the list of supported locales. -Note that C<:utf8> PerlIO layer must always be specified exactly like -that, it is not subject to the loose matching of encoding names. - -When open() is given an explicit list of layers they are appended to -the list declared using this pragma. +When open() is given an explicit list of layers (with the three-arg +syntax), they override the list declared using this pragma. The C<:std> subpragma on its own has no effect, but if combined with the C<:utf8> or C<:encoding> subpragmas, it converts the standard filehandles (STDIN, STDOUT, STDERR) to comply with encoding selected for input/output handles. For example, if both input and out are -chosen to be C<:utf8>, a C<:std> will mean that STDIN, STDOUT, and -STDERR are also in C<:utf8>. On the other hand, if only output is -chosen to be in C<< :encoding(koi8r) >>, a C<:std> will cause only the -STDOUT and STDERR to be in C. The C<:locale> subpragma +chosen to be C<:encoding(utf8)>, a C<:std> will mean that STDIN, STDOUT, +and STDERR are also in C<:encoding(utf8)>. On the other hand, if only +output is chosen to be in C<< :encoding(koi8r) >>, a C<:std> will cause +only the STDOUT and STDERR to be in C. The C<:locale> subpragma implicitly turns on C<:std>. -The logic of C<:locale> is described in full in L, +The logic of C<:locale> is described in full in L, but in short it is first trying nl_langinfo(CODESET) and then guessing from the LC_ALL and LANG locale environment variables.