Integrate perlio:

[  9384]
Various EBCDIC fixes:
- major revelation that swash code is encoding aware,
(or thought it was) - now it is ;-)
- With that out of the way fix a slab of tr/// cases.
- Fix Encode 'Unicode' to be true Unicode so tests pass.
- As anticipated Base64.xs needed tweaks.
- Until tr/// works right avoid old_encode64 in MIME tests.

p4raw-link: @9384 on //depot/perlio: 5ad8ef521b3ffc4e6bbbb9941bc4940d442b56b2

p4raw-id: //depot/perl@9389

2 files changed, 46 insertions, 12 deletions

diff --git a/ext/MIME/Base64/Base64.xs b/ext/MIME/Base64/Base64.xs
index 118d170823..f77ba14eab 100644
--- a/ext/MIME/Base64/Base64.xs
+++ b/ext/MIME/Base64/Base64.xs
@@ -11,15 +11,15 @@ metamail, which comes with this message:
 
   Copyright (c) 1991 Bell Communications Research, Inc. (Bellcore)
 
-  Permission to use, copy, modify, and distribute this material 
-  for any purpose and without fee is hereby granted, provided 
-  that the above copyright notice and this permission notice 
-  appear in all copies, and that the name of Bellcore not be 
-  used in advertising or publicity pertaining to this 
-  material without the specific, prior written permission 
-  of an authorized representative of Bellcore.	BELLCORE 
-  MAKES NO REPRESENTATIONS ABOUT THE ACCURACY OR SUITABILITY 
-  OF THIS MATERIAL FOR ANY PURPOSE.  IT IS PROVIDED "AS IS", 
+  Permission to use, copy, modify, and distribute this material
+  for any purpose and without fee is hereby granted, provided
+  that the above copyright notice and this permission notice
+  appear in all copies, and that the name of Bellcore not be
+  used in advertising or publicity pertaining to this
+  material without the specific, prior written permission
+  of an authorized representative of Bellcore.	BELLCORE
+  MAKES NO REPRESENTATIONS ABOUT THE ACCURACY OR SUITABILITY
+  OF THIS MATERIAL FOR ANY PURPOSE.  IT IS PROVIDED "AS IS",
   WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
 
 */
@@ -160,7 +160,7 @@ decode_base64(sv)
 
 	PREINIT:
 	STRLEN len;
-	register unsigned char *str = (unsigned char*)SvPV(sv, len);
+	register unsigned char *str = (unsigned char*)SvPVbyte(sv, len);
 	unsigned char const* end = str + len;
 	char *r;
 	unsigned char c[4];
@@ -177,7 +177,7 @@ decode_base64(sv)
 	while (str < end) {
 	    int i = 0;
             do {
-		unsigned char uc = index_64[*str++];
+		unsigned char uc = index_64[NATIVE_TO_ASCII(*str++)];
 		if (uc != INVALID)
 		    c[i++] = uc;
 
@@ -192,7 +192,7 @@ decode_base64(sv)
 		    break;
 		}
             } while (i < 4);
-	    
+	
 	    if (c[0] == EQ || c[1] == EQ) {
 		if (PL_dowarn) warn("Premature padding of base64 data");
 		break;
diff --git a/ext/MIME/Base64/QuotedPrint.pm b/ext/MIME/Base64/QuotedPrint.pm
index ccdee2bbfa..069f3226e9 100644
--- a/ext/MIME/Base64/QuotedPrint.pm
+++ b/ext/MIME/Base64/QuotedPrint.pm
@@ -112,4 +112,38 @@ sub decode_qp ($)
 *encode = \&encode_qp;
 *decode = \&decode_qp;
 
+# Methods for use as a PerlIO layer object
+
+sub PUSHED
+{
+ my ($class,$mode) = @_;
+ # When writing we buffer the data
+ my $write = '';
+ return bless \$write,$class;
+}
+
+sub FILL
+{
+ my ($obj,$fh) = @_;
+ my $line = <$fh>;
+ return (defined $line) ? decode_qp($line) : undef;
+ return undef;
+}
+
+sub WRITE
+{
+ my ($obj,$buf,$fh) = @_;
+ $$obj .= encode_qp($buf);
+ return length($buf);
+}
+
+sub FLUSH
+{
+ my ($obj,$fh) = @_;
+ print $fh $$obj or return -1;
+ $$obj = '';
+ return 0;
+}
+
+
 1;