This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Document the UTF-16 surrogate encoding and decoding.
[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) {
ba6ce41c
GS
13 eval {
14 # I18N::Langinfo isn't available everywhere
15 require I18N::Langinfo;
16 I18N::Langinfo->import('langinfo', 'CODESET');
17 };
58d53262 18 unless ($@) {
ba6ce41c 19 $locale_encoding = langinfo(CODESET());
58d53262 20 }
11fc5dc3 21 my $country_language;
58d53262 22 if (not $locale_encoding && in_locale()) {
11fc5dc3
JH
23 if ($ENV{LC_ALL} =~ /^([^.]+)\.([^.]+)$/) {
24 ($country_language, $locale_encoding) = ($1, $2);
25 } elsif ($ENV{LANG} =~ /^([^.]+)\.([^.]+)$/) {
26 ($country_language, $locale_encoding) = ($1, $2);
58d53262
JH
27 }
28 } else {
29 # Could do heuristics based on the country and language
30 # parts of LC_ALL and LANG (the parts before the dot (if any)),
31 # since we have Locale::Country and Locale::Language available.
32 # TODO: get a database of Language -> Encoding mappings
421e5dc3
JH
33 # (the Estonian database at http://www.eki.ee/letter/
34 # would be excellent!) --jhi
58d53262 35 }
11fc5dc3
JH
36 if (defined $locale_encoding &&
37 $locale_encoding eq 'euc' &&
38 defined $country_language) {
56fb2e42 39 if ($country_language =~ /^ja_JP|japan(?:ese)?$/i) {
11fc5dc3 40 $locale_encoding = 'eucjp';
5a192dee 41 } elsif ($country_language =~ /^ko_KR|korean?$/i) {
11fc5dc3 42 $locale_encoding = 'euckr';
56fb2e42 43 } elsif ($country_language =~ /^zh_TW|taiwan(?:ese)?$/i) {
11fc5dc3
JH
44 $locale_encoding = 'euctw';
45 }
46 croak "Locale encoding 'euc' too ambiguous"
47 if $locale_encoding eq 'euc';
48 }
58d53262
JH
49 }
50}
51
16fe6d59 52sub import {
dfebf958
NIS
53 my ($class,@args) = @_;
54 croak("`use open' needs explicit list of disciplines") unless @args;
16fe6d59 55 $^H |= $open::hint_bits;
ba6ce41c 56 my ($in,$out) = split(/\0/,(${^OPEN} || "\0"), -1);
dfebf958
NIS
57 while (@args) {
58 my $type = shift(@args);
59 my $discp = shift(@args);
ac27b0f5 60 my @val;
dfebf958
NIS
61 foreach my $layer (split(/\s+/,$discp)) {
62 $layer =~ s/^://;
58d53262
JH
63 if ($layer eq 'locale') {
64 use Encode;
65 _get_locale_encoding()
66 unless defined $locale_encoding;
67 croak "Cannot figure out an encoding to use"
68 unless defined $locale_encoding;
11fc5dc3
JH
69 if ($locale_encoding =~ /^utf-?8$/i) {
70 $layer = "utf8";
71 } else {
738b23dc 72 $layer = "encoding($locale_encoding)";
11fc5dc3 73 }
97ed432b
NIS
74 } else {
75 unless(PerlIO::Layer::->find($layer)) {
76 carp("Unknown discipline layer '$layer'");
77 }
ac27b0f5
NIS
78 }
79 push(@val,":$layer");
80 if ($layer =~ /^(crlf|raw)$/) {
81 $^H{"open_$type"} = $layer;
16fe6d59 82 }
ac27b0f5 83 }
738b23dc 84 # print "# type = $type, val = @val\n";
ac27b0f5
NIS
85 if ($type eq 'IN') {
86 $in = join(' ',@val);
87 }
88 elsif ($type eq 'OUT') {
89 $out = join(' ',@val);
16fe6d59 90 }
f3b00462
JH
91 elsif ($type eq 'INOUT') {
92 $in = $out = join(' ',@val);
93 }
16fe6d59 94 else {
ac27b0f5 95 croak "Unknown discipline class '$type'";
16fe6d59
GS
96 }
97 }
ac27b0f5 98 ${^OPEN} = join('\0',$in,$out);
16fe6d59
GS
99}
100
1011;
102__END__
d1edabcf
GS
103
104=head1 NAME
105
106open - perl pragma to set default disciplines for input and output
107
108=head1 SYNOPSIS
109
16fe6d59 110 use open IN => ":crlf", OUT => ":raw";
f3b00462 111 use open INOUT => ":utf8";
d1edabcf
GS
112
113=head1 DESCRIPTION
114
d151aa0e
JH
115Full-fledged support for I/O disciplines is now implemented provided
116Perl is configured to use PerlIO as its IO system (which is now the
117default).
16fe6d59 118
7d3b96bb
NIS
119The C<open> pragma serves as one of the interfaces to declare default
120"layers" (aka disciplines) for all I/O.
121
122The C<open> pragma is used to declare one or more default layers for
d151aa0e
JH
123I/O operations. Any open(), readpipe() (aka qx//) and similar
124operators found within the lexical scope of this pragma will use the
125declared defaults.
7d3b96bb 126
d151aa0e
JH
127When open() is given an explicit list of layers they are appended to
128the list declared using this pragma.
7d3b96bb
NIS
129
130Directory handles may also support disciplines in future.
131
132=head1 NONPERLIO FUNCTIONALITY
133
d151aa0e
JH
134If Perl is not built to use PerlIO as its IO system then only the two
135pseudo-disciplines ":raw" and ":crlf" are available.
16fe6d59
GS
136
137The ":raw" discipline corresponds to "binary mode" and the ":crlf"
138discipline corresponds to "text mode" on platforms that distinguish
139between the two modes when opening files (which is many DOS-like
d151aa0e
JH
140platforms, including Windows). These two disciplines are no-ops on
141platforms where binmode() is a no-op, but perform their functions
142everywhere if PerlIO is enabled.
7d3b96bb
NIS
143
144=head1 IMPLEMENTATION DETAILS
d1edabcf 145
f3b00462
JH
146There is a class method in C<PerlIO::Layer> C<find> which is
147implemented as XS code. It is called by C<import> to validate the
148layers:
0c4f7ff0
NIS
149
150 PerlIO::Layer::->find("perlio")
151
f3b00462
JH
152The return value (if defined) is a Perl object, of class
153C<PerlIO::Layer> which is created by the C code in F<perlio.c>. As
154yet there is nothing useful you can do with the object at the perl
155level.
16fe6d59 156
d1edabcf
GS
157=head1 SEE ALSO
158
1768d7eb
JH
159L<perlfunc/"binmode">, L<perlfunc/"open">, L<perlunicode>, L<PerlIO>,
160L<encoding>
d1edabcf
GS
161
162=cut