From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Sun, 10 Mar 2002 16:35:55 +0000 (+0000)
Subject: Implement :std subpragma of the open pragma
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b178108dc470b74242476037c9116c4f327f151d;p=p5sagit%2Fp5-mst-13.2.git

Implement :std subpragma of the open pragma
that makes the standard filehandles to talk in
encodings.  This change set off a weird warning
from op.c, though: disabled it now until someone
who knows what it is about comes along.

p4raw-id: //depot/perl@15146
---

diff --git a/lib/open.pm b/lib/open.pm
index 3f2d034..7e3fdf0 100644
--- a/lib/open.pm
+++ b/lib/open.pm
@@ -6,7 +6,7 @@ our $VERSION = '1.01';
 
 my $locale_encoding;
 
-sub in_locale { $^H & $locale::hint_bits }
+sub in_locale { $^H & ($locale::hint_bits || 0)}
 
 sub _get_locale_encoding {
     unless (defined $locale_encoding) {
@@ -59,6 +59,7 @@ sub _get_locale_encoding {
 sub import {
     my ($class,@args) = @_;
     croak("`use open' needs explicit list of disciplines") unless @args;
+    my $std;
     $^H |= $open::hint_bits;
     my ($in,$out) = split(/\0/,(${^OPEN} || "\0"), -1);
     while (@args) {
@@ -67,6 +68,9 @@ sub import {
 	if ($type =~ /^:?(utf8|locale|encoding\(.+\))$/) {
 	    $type = 'IO';
 	    $dscp = ":$1";
+	} elsif ($type eq ':std') {
+	    $std = 1;
+	    next;
 	} else {
 	    $dscp = shift(@args) || '';
 	}
@@ -84,6 +88,7 @@ sub import {
 		} else {
 		    $layer = "encoding($locale_encoding)";
 		}
+		$std = 1;
 	    } else {
 		unless(PerlIO::Layer::->find($layer)) {
 		    carp("Unknown discipline layer '$layer'");
@@ -94,7 +99,6 @@ sub import {
 		$^H{"open_$type"} = $layer;
 	    }
 	}
-	# print "# type = $type, val = @val\n";
 	if ($type eq 'IN') {
 	    $in  = join(' ',@val);
 	}
@@ -109,6 +113,24 @@ sub import {
 	}
     }
     ${^OPEN} = join("\0",$in,$out) if $in or $out;
+    if ($std) {
+	if ($in) {
+	    if ($in =~ /:utf8\b/) {
+		    binmode(STDIN,  ":utf8");
+		} elsif ($in =~ /(\w+\(.+\))/) {
+		    binmode(STDIN,  ":$1");
+		}
+	}
+	if ($out) {
+	    if ($out =~ /:utf8\b/) {
+		binmode(STDOUT,  ":utf8");
+		binmode(STDERR,  ":utf8");
+	    } elsif ($out =~ /(\w+\(.+\))/) {
+		binmode(STDOUT,  ":$1");
+		binmode(STDERR,  ":$1");
+	    }
+	}
+    }
 }
 
 1;
@@ -130,6 +152,8 @@ open - perl pragma to set default disciplines for input and output
     use open ':locale';
     use open ':encoding(iso-8859-7)';
 
+    use open ':std';
+
 =head1 DESCRIPTION
 
 Full-fledged support for I/O disciplines is now implemented provided
@@ -183,6 +207,16 @@ and these
 When open() is given an explicit list of layers they are appended to
 the list declared using this pragma.
 
+The C<:std> subpragma on its own has no effect, but if combined with
+the C<:utf8> or C<:encoding> subpragmas, it converts the standard
+filehandles (STDIN, STDOUT, STDERR) to comply with encoding selected
+for input/output handles.  For example, if both input and out are
+chosen to be C<:utf8>, a C<:std> will mean that STDIN, STDOUT, and
+STDERR are also in C<:utf8>.  On the other hand, if only output is
+chosen to be in C<:encoding(koi8r)', a C<:std> will cause only the
+STDOUT and STDERR to be in C<koi8r>.  The C<:locale> subpragma
+implicitly turns on C<:std>.
+
 The logic of C<:locale> is as follows:
 
 =over 4
diff --git a/op.c b/op.c
index b0d4006..5b11567 100644
--- a/op.c
+++ b/op.c
@@ -927,7 +927,9 @@ S_cop_free(pTHX_ COP* cop)
 #ifdef USE_ITHREADS
 	STRLEN len;
         char *s = SvPV(cop->cop_io,len);
-	Perl_warn(aTHX_ "io='%.*s'",(int) len,s);
+#if 0
+	Perl_warn(aTHX_ "io='%.*s'",(int) len,s); /* ??? --jhi */
+#endif
 #else
 	SvREFCNT_dec(cop->cop_io);
 #endif