3 $open::hint_bits = 0x20000;
9 sub in_locale { $^H & $locale::hint_bits }
11 sub _get_locale_encoding {
12 unless (defined $locale_encoding) {
13 # I18N::Langinfo isn't available everywhere
15 require I18N::Langinfo;
16 I18N::Langinfo->import(qw(langinfo CODESET));
17 $locale_encoding = langinfo(CODESET());
20 print "# locale_encoding = $locale_encoding\n";
23 if (not $locale_encoding && in_locale()) {
24 if ($ENV{LC_ALL} =~ /^([^.]+)\.([^.]+)$/) {
25 ($country_language, $locale_encoding) = ($1, $2);
26 } elsif ($ENV{LANG} =~ /^([^.]+)\.([^.]+)$/) {
27 ($country_language, $locale_encoding) = ($1, $2);
29 } elsif (not $locale_encoding) {
30 if ($ENV{LC_ALL} =~ /\butf-?8\b/i ||
31 $ENV{LANG} =~ /\butf-?8\b/i) {
32 $locale_encoding = 'utf8';
34 # Could do more heuristics based on the country and language
35 # parts of LC_ALL and LANG (the parts before the dot (if any)),
36 # since we have Locale::Country and Locale::Language available.
37 # TODO: get a database of Language -> Encoding mappings
38 # (the Estonian database at http://www.eki.ee/letter/
39 # would be excellent!) --jhi
41 if (defined $locale_encoding &&
42 $locale_encoding eq 'euc' &&
43 defined $country_language) {
44 if ($country_language =~ /^ja_JP|japan(?:ese)?$/i) {
45 $locale_encoding = 'euc-jp';
46 } elsif ($country_language =~ /^ko_KR|korean?$/i) {
47 $locale_encoding = 'euc-kr';
48 } elsif ($country_language =~ /^zh_TW|taiwan(?:ese)?$/i) {
49 $locale_encoding = 'euc-tw';
51 croak "Locale encoding 'euc' too ambiguous"
52 if $locale_encoding eq 'euc';
58 my ($class,@args) = @_;
59 croak("`use open' needs explicit list of disciplines") unless @args;
60 $^H |= $open::hint_bits;
61 my ($in,$out) = split(/\0/,(${^OPEN} || "\0"), -1);
63 my $type = shift(@args);
65 if ($type =~ /^:?(utf8|locale|encoding\(.+\))$/) {
72 foreach my $layer (split(/\s+/,$dscp)) {
74 if ($layer eq 'locale') {
76 _get_locale_encoding()
77 unless defined $locale_encoding;
78 croak "Cannot figure out an encoding to use"
79 unless defined $locale_encoding;
80 if ($locale_encoding =~ /^utf-?8$/i) {
83 $layer = "encoding($locale_encoding)";
86 unless(PerlIO::Layer::->find($layer)) {
87 carp("Unknown discipline layer '$layer'");
91 if ($layer =~ /^(crlf|raw)$/) {
92 $^H{"open_$type"} = $layer;
95 # print "# type = $type, val = @val\n";
99 elsif ($type eq 'OUT') {
100 $out = join(' ',@val);
102 elsif ($type eq 'IO') {
103 $in = $out = join(' ',@val);
106 croak "Unknown discipline class '$type'";
109 ${^OPEN} = join("\0",$in,$out);
117 open - perl pragma to set default disciplines for input and output
121 use open IN => ":crlf", OUT => ":raw";
122 use open OUT => ':utf8';
123 use open IO => ":encoding(iso-8859-7)";
125 use open IO => ':locale';
129 use open ':encoding(iso-8859-7)';
133 Full-fledged support for I/O disciplines is now implemented provided
134 Perl is configured to use PerlIO as its IO system (which is now the
137 The C<open> pragma serves as one of the interfaces to declare default
138 "layers" (aka disciplines) for all I/O.
140 The C<open> pragma is used to declare one or more default layers for
141 I/O operations. Any open(), readpipe() (aka qx//) and similar
142 operators found within the lexical scope of this pragma will use the
145 With the C<IN> subpragma you can declare the default layers
146 of input streams, and with the C<OUT> subpragma you can declare
147 the default layers of output streams. With the C<IO> subpragma
148 you can control both input and output streams simultaneously.
150 If you have a legacy encoding, you can use the C<:encoding(...)> tag.
152 if you want to set your encoding disciplines based on your
153 locale environment variables, you can use the C<:locale> tag.
156 $ENV{LANG} = 'ru_RU.KOI8-R';
157 # the :locale will probe the locale environment variables like LANG
158 use open OUT => ':locale';
160 print O chr(0x430); # Unicode CYRILLIC SMALL LETTER A = KOI8-R 0xc1
163 printf "%#x\n", ord(<I>), "\n"; # this should print 0xc1
169 use open IO => ':utf8';
174 use open IO => ':locale';
178 use open ':encoding(iso-8859-7)';
179 use open IO => ':encoding(iso-8859-7)';
181 When open() is given an explicit list of layers they are appended to
182 the list declared using this pragma.
184 Directory handles may also support disciplines in future.
186 =head1 NONPERLIO FUNCTIONALITY
188 If Perl is not built to use PerlIO as its IO system then only the two
189 pseudo-disciplines ":raw" and ":crlf" are available.
191 The ":raw" discipline corresponds to "binary mode" and the ":crlf"
192 discipline corresponds to "text mode" on platforms that distinguish
193 between the two modes when opening files (which is many DOS-like
194 platforms, including Windows). These two disciplines are no-ops on
195 platforms where binmode() is a no-op, but perform their functions
196 everywhere if PerlIO is enabled.
198 =head1 IMPLEMENTATION DETAILS
200 There is a class method in C<PerlIO::Layer> C<find> which is
201 implemented as XS code. It is called by C<import> to validate the
204 PerlIO::Layer::->find("perlio")
206 The return value (if defined) is a Perl object, of class
207 C<PerlIO::Layer> which is created by the C code in F<perlio.c>. As
208 yet there is nothing useful you can do with the object at the perl
213 L<perlfunc/"binmode">, L<perlfunc/"open">, L<perlunicode>, L<PerlIO>,