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