1package open; 2use warnings; 3 4our $VERSION = '1.07'; 5 6require 5.008001; # for PerlIO::get_layers() 7 8my $locale_encoding; 9 10sub _get_encname { 11 return ($1, Encode::resolve_alias($1)) if $_[0] =~ /^:?encoding\((.+)\)$/; 12 return; 13} 14 15sub croak { 16 require Carp; goto &Carp::croak; 17} 18 19sub _drop_oldenc { 20 # If by the time we arrive here there already is at the top of the 21 # perlio layer stack an encoding identical to what we would like 22 # to push via this open pragma, we will pop away the old encoding 23 # (+utf8) so that we can push ourselves in place (this is easier 24 # than ignoring pushing ourselves because of the way how ${^OPEN} 25 # works). So we are looking for something like 26 # 27 # stdio encoding(xxx) utf8 28 # 29 # in the existing layer stack, and in the new stack chunk for 30 # 31 # :encoding(xxx) 32 # 33 # If we find a match, we pop the old stack (once, since 34 # the utf8 is just a flag on the encoding layer) 35 my ($h, @new) = @_; 36 return unless @new >= 1 && $new[-1] =~ /^:encoding\(.+\)$/; 37 my @old = PerlIO::get_layers($h); 38 return unless @old >= 3 && 39 $old[-1] eq 'utf8' && 40 $old[-2] =~ /^encoding\(.+\)$/; 41 require Encode; 42 my ($loname, $lcname) = _get_encname($old[-2]); 43 unless (defined $lcname) { # Should we trust get_layers()? 44 croak("open: Unknown encoding '$loname'"); 45 } 46 my ($voname, $vcname) = _get_encname($new[-1]); 47 unless (defined $vcname) { 48 croak("open: Unknown encoding '$voname'"); 49 } 50 if ($lcname eq $vcname) { 51 binmode($h, ":pop"); # utf8 is part of the encoding layer 52 } 53} 54 55sub import { 56 my ($class,@args) = @_; 57 croak("open: needs explicit list of PerlIO layers") unless @args; 58 my $std; 59 my ($in,$out) = split(/\0/,(${^OPEN} || "\0"), -1); 60 while (@args) { 61 my $type = shift(@args); 62 my $dscp; 63 if ($type =~ /^:?(utf8|locale|encoding\(.+\))$/) { 64 $type = 'IO'; 65 $dscp = ":$1"; 66 } elsif ($type eq ':std') { 67 $std = 1; 68 next; 69 } else { 70 $dscp = shift(@args) || ''; 71 } 72 my @val; 73 foreach my $layer (split(/\s+/,$dscp)) { 74 $layer =~ s/^://; 75 if ($layer eq 'locale') { 76 require Encode; 77 require encoding; 78 $locale_encoding = encoding::_get_locale_encoding() 79 unless defined $locale_encoding; 80 (warnings::warnif("layer", "Cannot figure out an encoding to use"), last) 81 unless defined $locale_encoding; 82 $layer = "encoding($locale_encoding)"; 83 $std = 1; 84 } else { 85 my $target = $layer; # the layer name itself 86 $target =~ s/^(\w+)\(.+\)$/$1/; # strip parameters 87 88 unless(PerlIO::Layer::->find($target,1)) { 89 warnings::warnif("layer", "Unknown PerlIO layer '$target'"); 90 } 91 } 92 push(@val,":$layer"); 93 if ($layer =~ /^(crlf|raw)$/) { 94 $^H{"open_$type"} = $layer; 95 } 96 } 97 if ($type eq 'IN') { 98 _drop_oldenc(*STDIN, @val); 99 $in = join(' ', @val); 100 } 101 elsif ($type eq 'OUT') { 102 _drop_oldenc(*STDOUT, @val); 103 $out = join(' ', @val); 104 } 105 elsif ($type eq 'IO') { 106 _drop_oldenc(*STDIN, @val); 107 _drop_oldenc(*STDOUT, @val); 108 $in = $out = join(' ', @val); 109 } 110 else { 111 croak "Unknown PerlIO layer class '$type'"; 112 } 113 } 114 ${^OPEN} = join("\0", $in, $out); 115 if ($std) { 116 if ($in) { 117 if ($in =~ /:utf8\b/) { 118 binmode(STDIN, ":utf8"); 119 } elsif ($in =~ /(\w+\(.+\))/) { 120 binmode(STDIN, ":$1"); 121 } 122 } 123 if ($out) { 124 if ($out =~ /:utf8\b/) { 125 binmode(STDOUT, ":utf8"); 126 binmode(STDERR, ":utf8"); 127 } elsif ($out =~ /(\w+\(.+\))/) { 128 binmode(STDOUT, ":$1"); 129 binmode(STDERR, ":$1"); 130 } 131 } 132 } 133} 134 1351; 136__END__ 137 138=head1 NAME 139 140open - perl pragma to set default PerlIO layers for input and output 141 142=head1 SYNOPSIS 143 144 use open IN => ":crlf", OUT => ":bytes"; 145 use open OUT => ':utf8'; 146 use open IO => ":encoding(iso-8859-7)"; 147 148 use open IO => ':locale'; 149 150 use open ':encoding(utf8)'; 151 use open ':locale'; 152 use open ':encoding(iso-8859-7)'; 153 154 use open ':std'; 155 156=head1 DESCRIPTION 157 158Full-fledged support for I/O layers is now implemented provided 159Perl is configured to use PerlIO as its IO system (which is now the 160default). 161 162The C<open> pragma serves as one of the interfaces to declare default 163"layers" (also known as "disciplines") for all I/O. Any two-argument 164open(), readpipe() (aka qx//) and similar operators found within the 165lexical scope of this pragma will use the declared defaults. 166Even three-argument opens may be affected by this pragma 167when they don't specify IO layers in MODE. 168 169With the C<IN> subpragma you can declare the default layers 170of input streams, and with the C<OUT> subpragma you can declare 171the default layers of output streams. With the C<IO> subpragma 172you can control both input and output streams simultaneously. 173 174If you have a legacy encoding, you can use the C<:encoding(...)> tag. 175 176If you want to set your encoding layers based on your 177locale environment variables, you can use the C<:locale> tag. 178For example: 179 180 $ENV{LANG} = 'ru_RU.KOI8-R'; 181 # the :locale will probe the locale environment variables like LANG 182 use open OUT => ':locale'; 183 open(O, ">koi8"); 184 print O chr(0x430); # Unicode CYRILLIC SMALL LETTER A = KOI8-R 0xc1 185 close O; 186 open(I, "<koi8"); 187 printf "%#x\n", ord(<I>), "\n"; # this should print 0xc1 188 close I; 189 190These are equivalent 191 192 use open ':encoding(utf8)'; 193 use open IO => ':encoding(utf8)'; 194 195as are these 196 197 use open ':locale'; 198 use open IO => ':locale'; 199 200and these 201 202 use open ':encoding(iso-8859-7)'; 203 use open IO => ':encoding(iso-8859-7)'; 204 205The matching of encoding names is loose: case does not matter, and 206many encodings have several aliases. See L<Encode::Supported> for 207details and the list of supported locales. 208 209When open() is given an explicit list of layers (with the three-arg 210syntax), they override the list declared using this pragma. 211 212The C<:std> subpragma on its own has no effect, but if combined with 213the C<:utf8> or C<:encoding> subpragmas, it converts the standard 214filehandles (STDIN, STDOUT, STDERR) to comply with encoding selected 215for input/output handles. For example, if both input and out are 216chosen to be C<:encoding(utf8)>, a C<:std> will mean that STDIN, STDOUT, 217and STDERR are also in C<:encoding(utf8)>. On the other hand, if only 218output is chosen to be in C<< :encoding(koi8r) >>, a C<:std> will cause 219only the STDOUT and STDERR to be in C<koi8r>. The C<:locale> subpragma 220implicitly turns on C<:std>. 221 222The logic of C<:locale> is described in full in L<encoding>, 223but in short it is first trying nl_langinfo(CODESET) and then 224guessing from the LC_ALL and LANG locale environment variables. 225 226Directory handles may also support PerlIO layers in the future. 227 228=head1 NONPERLIO FUNCTIONALITY 229 230If Perl is not built to use PerlIO as its IO system then only the two 231pseudo-layers C<:bytes> and C<:crlf> are available. 232 233The C<:bytes> layer corresponds to "binary mode" and the C<:crlf> 234layer corresponds to "text mode" on platforms that distinguish 235between the two modes when opening files (which is many DOS-like 236platforms, including Windows). These two layers are no-ops on 237platforms where binmode() is a no-op, but perform their functions 238everywhere if PerlIO is enabled. 239 240=head1 IMPLEMENTATION DETAILS 241 242There is a class method in C<PerlIO::Layer> C<find> which is 243implemented as XS code. It is called by C<import> to validate the 244layers: 245 246 PerlIO::Layer::->find("perlio") 247 248The return value (if defined) is a Perl object, of class 249C<PerlIO::Layer> which is created by the C code in F<perlio.c>. As 250yet there is nothing useful you can do with the object at the perl 251level. 252 253=head1 SEE ALSO 254 255L<perlfunc/"binmode">, L<perlfunc/"open">, L<perlunicode>, L<PerlIO>, 256L<encoding> 257 258=cut 259