Mention sv_gets as the Perl-ish fgets-ish API.
[perl.git] / lib / open.pm
1 package open;
2 use warnings;
3
4 our $VERSION = '1.10';
5
6 require 5.008001; # for PerlIO::get_layers()
7
8 my $locale_encoding;
9
10 sub _get_encname {
11     return ($1, Encode::resolve_alias($1)) if $_[0] =~ /^:?encoding\((.+)\)$/;
12     return;
13 }
14
15 sub croak {
16     require Carp; goto &Carp::croak;
17 }
18
19 sub _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
55 sub 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) if $std;
99             $in  = join(' ', @val);
100         }
101         elsif ($type eq 'OUT') {
102             if ($std) {
103                 _drop_oldenc(*STDOUT, @val);
104                 _drop_oldenc(*STDERR, @val);
105             }
106             $out = join(' ', @val);
107         }
108         elsif ($type eq 'IO') {
109             if ($std) {
110                 _drop_oldenc(*STDIN, @val);
111                 _drop_oldenc(*STDOUT, @val);
112                 _drop_oldenc(*STDERR, @val);
113             }
114             $in = $out = join(' ', @val);
115         }
116         else {
117             croak "Unknown PerlIO layer class '$type' (need IN, OUT or IO)";
118         }
119     }
120     ${^OPEN} = join("\0", $in, $out);
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     }
139 }
140
141 1;
142 __END__
143
144 =head1 NAME
145
146 open - perl pragma to set default PerlIO layers for input and output
147
148 =head1 SYNOPSIS
149
150     use open IN  => ":crlf", OUT => ":bytes";
151     use open OUT => ':utf8';
152     use open IO  => ":encoding(iso-8859-7)";
153
154     use open IO  => ':locale';
155
156     use open ':encoding(utf8)';
157     use open ':locale';
158     use open ':encoding(iso-8859-7)';
159
160     use open ':std';
161
162 =head1 DESCRIPTION
163
164 Full-fledged support for I/O layers is now implemented provided
165 Perl is configured to use PerlIO as its IO system (which is now the
166 default).
167
168 The C<open> pragma serves as one of the interfaces to declare default
169 "layers" (also known as "disciplines") for all I/O. Any two-argument
170 open(), readpipe() (aka qx//) and similar operators found within the
171 lexical scope of this pragma will use the declared defaults.
172 Even three-argument opens may be affected by this pragma
173 when they don't specify IO layers in MODE.
174
175 With the C<IN> subpragma you can declare the default layers
176 of input streams, and with the C<OUT> subpragma you can declare
177 the default layers of output streams.  With the C<IO>  subpragma
178 you can control both input and output streams simultaneously.
179
180 If you have a legacy encoding, you can use the C<:encoding(...)> tag.
181
182 If you want to set your encoding layers based on your
183 locale environment variables, you can use the C<:locale> tag.
184 For example:
185
186     $ENV{LANG} = 'ru_RU.KOI8-R';
187     # the :locale will probe the locale environment variables like LANG
188     use open OUT => ':locale';
189     open(O, ">koi8");
190     print O chr(0x430); # Unicode CYRILLIC SMALL LETTER A = KOI8-R 0xc1
191     close O;
192     open(I, "<koi8");
193     printf "%#x\n", ord(<I>), "\n"; # this should print 0xc1
194     close I;
195
196 These are equivalent
197
198     use open ':encoding(utf8)';
199     use open IO => ':encoding(utf8)';
200
201 as are these
202
203     use open ':locale';
204     use open IO => ':locale';
205
206 and these
207
208     use open ':encoding(iso-8859-7)';
209     use open IO => ':encoding(iso-8859-7)';
210
211 The matching of encoding names is loose: case does not matter, and
212 many encodings have several aliases.  See L<Encode::Supported> for
213 details and the list of supported locales.
214
215 When open() is given an explicit list of layers (with the three-arg
216 syntax), they override the list declared using this pragma.  open() can
217 also be given a single colon (:) for a layer name, to override this pragma
218 and use the default (C<:raw> on Unix, C<:crlf> on Windows).
219
220 The C<:std> subpragma on its own has no effect, but if combined with
221 the C<:utf8> or C<:encoding> subpragmas, it converts the standard
222 filehandles (STDIN, STDOUT, STDERR) to comply with encoding selected
223 for input/output handles.  For example, if both input and out are
224 chosen to be C<:encoding(utf8)>, a C<:std> will mean that STDIN, STDOUT,
225 and STDERR are also in C<:encoding(utf8)>.  On the other hand, if only
226 output is chosen to be in C<< :encoding(koi8r) >>, a C<:std> will cause
227 only the STDOUT and STDERR to be in C<koi8r>.  The C<:locale> subpragma
228 implicitly turns on C<:std>.
229
230 The logic of C<:locale> is described in full in L<encoding>,
231 but in short it is first trying nl_langinfo(CODESET) and then
232 guessing from the LC_ALL and LANG locale environment variables.
233
234 Directory handles may also support PerlIO layers in the future.
235
236 =head1 NONPERLIO FUNCTIONALITY
237
238 If Perl is not built to use PerlIO as its IO system then only the two
239 pseudo-layers C<:bytes> and C<:crlf> are available.
240
241 The C<:bytes> layer corresponds to "binary mode" and the C<:crlf>
242 layer corresponds to "text mode" on platforms that distinguish
243 between the two modes when opening files (which is many DOS-like
244 platforms, including Windows).  These two layers are no-ops on
245 platforms where binmode() is a no-op, but perform their functions
246 everywhere if PerlIO is enabled.
247
248 =head1 IMPLEMENTATION DETAILS
249
250 There is a class method in C<PerlIO::Layer> C<find> which is
251 implemented as XS code.  It is called by C<import> to validate the
252 layers:
253
254    PerlIO::Layer::->find("perlio")
255
256 The return value (if defined) is a Perl object, of class
257 C<PerlIO::Layer> which is created by the C code in F<perlio.c>.  As
258 yet there is nothing useful you can do with the object at the perl
259 level.
260
261 =head1 SEE ALSO
262
263 L<perlfunc/"binmode">, L<perlfunc/"open">, L<perlunicode>, L<PerlIO>,
264 L<encoding>
265
266 =cut