This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Root is the lizard king.
[perl5.git] / lib / open.pm
CommitLineData
d1edabcf 1package open;
ac27b0f5 2use Carp;
16fe6d59
GS
3$open::hint_bits = 0x20000;
4
0c4f7ff0 5our $VERSION = '1.01';
b75c8c73 6
58d53262
JH
7my $locale_encoding;
8
9sub in_locale { $^H & $locale::hint_bits }
10
11sub _get_locale_encoding {
12 unless (defined $locale_encoding) {
276c9210
JH
13 # I18N::Langinfo isn't available everywhere
14 eval "use I18N::Langinfo qw(langinfo CODESET)";
58d53262 15 unless ($@) {
ba6ce41c 16 $locale_encoding = langinfo(CODESET());
58d53262 17 }
11fc5dc3 18 my $country_language;
58d53262 19 if (not $locale_encoding && in_locale()) {
11fc5dc3
JH
20 if ($ENV{LC_ALL} =~ /^([^.]+)\.([^.]+)$/) {
21 ($country_language, $locale_encoding) = ($1, $2);
22 } elsif ($ENV{LANG} =~ /^([^.]+)\.([^.]+)$/) {
23 ($country_language, $locale_encoding) = ($1, $2);
58d53262 24 }
1e616cf5
JH
25 } elsif (not $locale_encoding) {
26 if ($ENV{LC_ALL} =~ /\butf-?8\b/i ||
27 $ENV{LANG} =~ /\butf-?8\b/i) {
28 $locale_encoding = 'utf8';
29 }
30 # Could do more heuristics based on the country and language
58d53262
JH
31 # parts of LC_ALL and LANG (the parts before the dot (if any)),
32 # since we have Locale::Country and Locale::Language available.
33 # TODO: get a database of Language -> Encoding mappings
421e5dc3
JH
34 # (the Estonian database at http://www.eki.ee/letter/
35 # would be excellent!) --jhi
58d53262 36 }
11fc5dc3
JH
37 if (defined $locale_encoding &&
38 $locale_encoding eq 'euc' &&
39 defined $country_language) {
56fb2e42 40 if ($country_language =~ /^ja_JP|japan(?:ese)?$/i) {
1e616cf5 41 $locale_encoding = 'euc-jp';
5a192dee 42 } elsif ($country_language =~ /^ko_KR|korean?$/i) {
1e616cf5 43 $locale_encoding = 'euc-kr';
56fb2e42 44 } elsif ($country_language =~ /^zh_TW|taiwan(?:ese)?$/i) {
1e616cf5 45 $locale_encoding = 'euc-tw';
11fc5dc3
JH
46 }
47 croak "Locale encoding 'euc' too ambiguous"
48 if $locale_encoding eq 'euc';
49 }
58d53262
JH
50 }
51}
52
16fe6d59 53sub import {
dfebf958
NIS
54 my ($class,@args) = @_;
55 croak("`use open' needs explicit list of disciplines") unless @args;
16fe6d59 56 $^H |= $open::hint_bits;
ba6ce41c 57 my ($in,$out) = split(/\0/,(${^OPEN} || "\0"), -1);
dfebf958
NIS
58 while (@args) {
59 my $type = shift(@args);
1e616cf5
JH
60 my $dscp;
61 if ($type =~ /^:?(utf8|locale|encoding\(.+\))$/) {
62 $type = 'IO';
63 $dscp = ":$1";
64 } else {
65 $dscp = shift(@args);
66 }
ac27b0f5 67 my @val;
1e616cf5 68 foreach my $layer (split(/\s+/,$dscp)) {
dfebf958 69 $layer =~ s/^://;
58d53262
JH
70 if ($layer eq 'locale') {
71 use Encode;
72 _get_locale_encoding()
73 unless defined $locale_encoding;
74 croak "Cannot figure out an encoding to use"
75 unless defined $locale_encoding;
11fc5dc3
JH
76 if ($locale_encoding =~ /^utf-?8$/i) {
77 $layer = "utf8";
78 } else {
738b23dc 79 $layer = "encoding($locale_encoding)";
11fc5dc3 80 }
97ed432b
NIS
81 } else {
82 unless(PerlIO::Layer::->find($layer)) {
83 carp("Unknown discipline layer '$layer'");
84 }
ac27b0f5
NIS
85 }
86 push(@val,":$layer");
87 if ($layer =~ /^(crlf|raw)$/) {
88 $^H{"open_$type"} = $layer;
16fe6d59 89 }
ac27b0f5 90 }
738b23dc 91 # print "# type = $type, val = @val\n";
ac27b0f5
NIS
92 if ($type eq 'IN') {
93 $in = join(' ',@val);
94 }
95 elsif ($type eq 'OUT') {
96 $out = join(' ',@val);
16fe6d59 97 }
1e616cf5 98 elsif ($type eq 'IO') {
f3b00462
JH
99 $in = $out = join(' ',@val);
100 }
16fe6d59 101 else {
ac27b0f5 102 croak "Unknown discipline class '$type'";
16fe6d59
GS
103 }
104 }
1e616cf5 105 ${^OPEN} = join("\0",$in,$out);
16fe6d59
GS
106}
107
1081;
109__END__
d1edabcf
GS
110
111=head1 NAME
112
113open - perl pragma to set default disciplines for input and output
114
115=head1 SYNOPSIS
116
1e616cf5
JH
117 use open IN => ":crlf", OUT => ":raw";
118 use open OUT => ':utf8';
119 use open IO => ":encoding(iso-8859-7)";
120
121 use open IO => ':locale';
122
123 use open ':utf8';
124 use open ':locale';
125 use open ':encoding(iso-8859-7)';
d1edabcf
GS
126
127=head1 DESCRIPTION
128
d151aa0e
JH
129Full-fledged support for I/O disciplines is now implemented provided
130Perl is configured to use PerlIO as its IO system (which is now the
131default).
16fe6d59 132
7d3b96bb
NIS
133The C<open> pragma serves as one of the interfaces to declare default
134"layers" (aka disciplines) for all I/O.
135
136The C<open> pragma is used to declare one or more default layers for
d151aa0e
JH
137I/O operations. Any open(), readpipe() (aka qx//) and similar
138operators found within the lexical scope of this pragma will use the
139declared defaults.
7d3b96bb 140
1e616cf5
JH
141With the C<IN> subpragma you can declare the default layers
142of input sterams, and with the C<OUT> subpragma you can declare
143the default layers of output streams. With the C<IO> subpragma
144you can control both input and output streams simultaneously.
145
146If you have a legacy encoding, you can use the C<:encoding(...)> tag.
147
148if you want to set your encoding disciplines based on your
149locale environment variables, you can use the C<:locale> tag.
150For example:
151
152 $ENV{LANG} = 'ru_RU.KOI8-R';
dbd62f41
JH
153 # the :locale will probe the locale environment variables like LANG
154 use open OUT => ':locale';
1e616cf5 155 open(O, ">koi8");
23bcb45a 156 print O chr(0x430); # Unicode CYRILLIC SMALL LETTER A = KOI8-R 0xc1
1e616cf5
JH
157 close O;
158 open(I, "<koi8");
23bcb45a 159 printf "%#x\n", ord(<I>), "\n"; # this should print 0xc1
1e616cf5
JH
160 close I;
161
162These are equivalent
163
164 use open ':utf8';
165 use open IO => ':utf8';
166
167as are these
168
169 use open ':locale';
170 use open IO => ':locale';
171
172and these
173
174 use open ':encoding(iso-8859-7)';
175 use open IO => ':encoding(iso-8859-7)';
176
d151aa0e
JH
177When open() is given an explicit list of layers they are appended to
178the list declared using this pragma.
7d3b96bb
NIS
179
180Directory handles may also support disciplines in future.
181
182=head1 NONPERLIO FUNCTIONALITY
183
d151aa0e
JH
184If Perl is not built to use PerlIO as its IO system then only the two
185pseudo-disciplines ":raw" and ":crlf" are available.
16fe6d59
GS
186
187The ":raw" discipline corresponds to "binary mode" and the ":crlf"
188discipline corresponds to "text mode" on platforms that distinguish
189between the two modes when opening files (which is many DOS-like
d151aa0e
JH
190platforms, including Windows). These two disciplines are no-ops on
191platforms where binmode() is a no-op, but perform their functions
192everywhere if PerlIO is enabled.
7d3b96bb
NIS
193
194=head1 IMPLEMENTATION DETAILS
d1edabcf 195
f3b00462
JH
196There is a class method in C<PerlIO::Layer> C<find> which is
197implemented as XS code. It is called by C<import> to validate the
198layers:
0c4f7ff0
NIS
199
200 PerlIO::Layer::->find("perlio")
201
f3b00462
JH
202The return value (if defined) is a Perl object, of class
203C<PerlIO::Layer> which is created by the C code in F<perlio.c>. As
204yet there is nothing useful you can do with the object at the perl
205level.
16fe6d59 206
d1edabcf
GS
207=head1 SEE ALSO
208
1768d7eb
JH
209L<perlfunc/"binmode">, L<perlfunc/"open">, L<perlunicode>, L<PerlIO>,
210L<encoding>
d1edabcf
GS
211
212=cut