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