From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Tue, 17 Feb 2004 23:10:22 +0000 (+0000)
Subject: Upgrade to MIME::Base64 3.00.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0a362e9d28eb95760d6605a4ce6ad3a83060c87d;p=p5sagit%2Fp5-mst-13.2.git

Upgrade to MIME::Base64 3.00.
Fix t/warn.t so it works in the core.
Reintegrate change #22309 in it. Bump $VERSION to 3.00_01.
p4raw-link: @22309 on //depot/perl: 1b96abaf83c640ae3fca4becfa82d376954d73cc

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

diff --git a/ext/MIME/Base64/Base64.pm b/ext/MIME/Base64/Base64.pm
index d0069f1..596a5df 100644
--- a/ext/MIME/Base64/Base64.pm
+++ b/ext/MIME/Base64/Base64.pm
@@ -1,8 +1,26 @@
-#
-# $Id: Base64.pm,v 2.37 2004/01/08 14:07:26 gisle Exp $
-
 package MIME::Base64;
 
+# $Id: Base64.pm,v 3.0 2004/01/14 11:59:07 gisle Exp $
+
+use strict;
+use vars qw(@ISA @EXPORT $VERSION);
+
+require Exporter;
+require DynaLoader;
+@ISA = qw(Exporter DynaLoader);
+@EXPORT = qw(encode_base64 decode_base64);
+
+$VERSION = '3.00_01';
+
+MIME::Base64->bootstrap($VERSION);
+
+*encode = \&encode_base64;
+*decode = \&decode_base64;
+
+1;
+
+__END__
+
 =head1 NAME
 
 MIME::Base64 - Encoding and decoding of base64 strings
@@ -132,104 +150,3 @@ Communications Research, Inc. (Bellcore)
 L<MIME::QuotedPrint>
 
 =cut
-
-use strict;
-use vars qw(@ISA @EXPORT $VERSION $OLD_CODE);
-
-require Exporter;
-require DynaLoader;
-@ISA = qw(Exporter DynaLoader);
-@EXPORT = qw(encode_base64 decode_base64);
-
-$VERSION = '2.23';
-
-eval { bootstrap MIME::Base64 $VERSION; };
-if ($@) {
-    # can't bootstrap XS implementation, use perl implementation
-    *encode_base64 = \&old_encode_base64;
-    *decode_base64 = \&old_decode_base64;
-
-    $OLD_CODE = $@;
-    #warn $@ if $^W;
-}
-
-# Historically this module has been implemented as pure perl code.
-# The XS implementation runs about 20 times faster, but the Perl
-# code might be more portable, so it is still here.
-
-sub old_encode_base64 ($;$)
-{
-    if ($] >= 5.006) {
-	require bytes;
-	if (bytes::length($_[0]) > length($_[0]) ||
-	    ($] >= 5.008 && $_[0] =~ /[^\0-\xFF]/))
-	{
-	    require Carp;
-	    Carp::croak("The Base64 encoding is only defined for bytes");
-	}
-    }
-
-    use integer;
-
-    my $eol = $_[1];
-    $eol = "\n" unless defined $eol;
-
-    my $res = pack("u", $_[0]);
-    # Remove first character of each line, remove newlines
-    $res =~ s/^.//mg;
-    $res =~ s/\n//g;
-
-    $res =~ tr|` -_|AA-Za-z0-9+/|;               # `# help emacs
-    # fix padding at the end
-    my $padding = (3 - length($_[0]) % 3) % 3;
-    $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
-    # break encoded string into lines of no more than 76 characters each
-    if (length $eol) {
-	$res =~ s/(.{1,76})/$1$eol/g;
-    }
-    return $res;
-}
-
-
-sub old_decode_base64 ($)
-{
-    local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]
-    use integer;
-
-    my $str = shift;
-    $str =~ tr|A-Za-z0-9+=/||cd;            # remove non-base64 chars
-    if (length($str) % 4) {
-	require Carp;
-	Carp::carp("Length of base64 data not a multiple of 4")
-    }
-    $str =~ s/=+$//;                        # remove padding
-    $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format
-    return "" unless length $str;
-
-    ## I guess this could be written as
-    #return unpack("u", join('', map( chr(32 + length($_)*3/4) . $_,
-    #			$str =~ /(.{1,60})/gs) ) );
-    ## but I do not like that...
-    my $uustr = '';
-    my ($i, $l);
-    $l = length($str) - 60;
-    for ($i = 0; $i <= $l; $i += 60) {
-	$uustr .= "M" . substr($str, $i, 60);
-    }
-    $str = substr($str, $i);
-    # and any leftover chars
-    if ($str ne "") {
-	$uustr .= chr(32 + length($str)*3/4) . $str;
-    }
-    return unpack ("u", $uustr);
-}
-
-# Set up aliases so that these functions also can be called as
-#
-#    MIME::Base64::encode();
-#    MIME::Base64::decode();
-
-*encode = \&encode_base64;
-*decode = \&decode_base64;
-
-1;
diff --git a/ext/MIME/Base64/Base64.xs b/ext/MIME/Base64/Base64.xs
index 14c8bea..5a59b1e 100644
--- a/ext/MIME/Base64/Base64.xs
+++ b/ext/MIME/Base64/Base64.xs
@@ -1,4 +1,4 @@
-/* $Id: Base64.xs,v 1.41 2004/01/08 14:07:26 gisle Exp $
+/* $Id: Base64.xs,v 3.0 2004/01/14 11:59:07 gisle Exp $
 
 Copyright 1997-2004 Gisle Aas
 
@@ -100,6 +100,10 @@ static unsigned char index_64[256] = {
 #   define SvPVbyte SvPV
 #endif
 
+#ifndef isXDIGIT
+#   define isXDIGIT isxdigit
+#endif
+
 #ifndef NATIVE_TO_ASCII
 #   define NATIVE_TO_ASCII(ch) (ch)
 #endif
diff --git a/ext/MIME/Base64/Changes b/ext/MIME/Base64/Changes
index 24b28af..067fc04 100644
--- a/ext/MIME/Base64/Changes
+++ b/ext/MIME/Base64/Changes
@@ -1,3 +1,18 @@
+2004-01-14   Gisle Aas <gisle@ActiveState.com>
+
+   Release 3.00
+
+   Drop the pure Perl implementations of the encoders and
+   decoders.  They are bloat that hides real problems in
+   the XS implementations.  I will re-release them separately
+   in the new MIME-Base64-Perl distribution.
+
+   The 'gcc -Wall' fix in 2.22 broke support for perl5.005,
+   as the isXDIGIT() macro is not available in that perl.
+   This problem has now been fixed.
+
+
+
 2004-01-08   Gisle Aas <gisle@ActiveState.com>
 
    Release 2.23
diff --git a/ext/MIME/Base64/QuotedPrint.pm b/ext/MIME/Base64/QuotedPrint.pm
index db78330..5a6bbfa 100644
--- a/ext/MIME/Base64/QuotedPrint.pm
+++ b/ext/MIME/Base64/QuotedPrint.pm
@@ -1,8 +1,25 @@
-#
-# $Id: QuotedPrint.pm,v 2.19 2004/01/08 14:07:26 gisle Exp $
-
 package MIME::QuotedPrint;
 
+# $Id: QuotedPrint.pm,v 3.0 2004/01/14 11:59:07 gisle Exp $
+
+use strict;
+use vars qw(@ISA @EXPORT $VERSION);
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(encode_qp decode_qp);
+
+$VERSION = "3.00";
+
+use MIME::Base64;  # will load XS version of {en,de}code_qp()
+
+*encode = \&encode_qp;
+*decode = \&decode_qp;
+
+1;
+
+__END__
+
 =head1 NAME
 
 MIME::QuotedPrint - Encoding and decoding of quoted-printable strings
@@ -86,121 +103,3 @@ modify it under the same terms as Perl itself.
 L<MIME::Base64>
 
 =cut
-
-use strict;
-use vars qw(@ISA @EXPORT $VERSION);
-if (ord('A') == 193) { # on EBCDIC machines we need translation help
-    require Encode;
-}
-
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT = qw(encode_qp decode_qp);
-
-$VERSION = "2.21";
-
-use MIME::Base64;  # try to load XS version of encode_qp
-unless (defined &encode_qp) {
-    *encode_qp = \&old_encode_qp;
-    *decode_qp = \&old_decode_qp;
-}
-
-sub old_encode_qp ($;$)
-{
-    my $res = shift;
-    if ($] >= 5.006) {
-	require bytes;
-	if (bytes::length($res) > length($res) ||
-	    ($] >= 5.008 && $res =~ /[^\0-\xFF]/))
-	{
-	    require Carp;
-	    Carp::croak("The Quoted-Printable encoding is only defined for bytes");
-	}
-    }
-
-    my $eol = shift;
-    $eol = "\n" unless defined $eol;
-
-    # Do not mention ranges such as $res =~ s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg;
-    # since that will not even compile on an EBCDIC machine (where ord('!') > ord('<')).
-    if (ord('A') == 193) { # EBCDIC style machine
-        if (ord('[') == 173) {
-            $res =~ s/([^ \t\n!"#\$%&'()*+,\-.\/0-9:;<>?\@A-Z[\\\]^_`a-z{|}~])/sprintf("=%02X", ord(Encode::encode('iso-8859-1',Encode::decode('cp1047',$1))))/eg;  # rule #2,#3
-            $res =~ s/([ \t]+)$/
-              join('', map { sprintf("=%02X", ord(Encode::encode('iso-8859-1',Encode::decode('cp1047',$_)))) }
-        		   split('', $1)
-              )/egm;                        # rule #3 (encode whitespace at eol)
-        }
-        elsif (ord('[') == 187) {
-            $res =~ s/([^ \t\n!"#\$%&'()*+,\-.\/0-9:;<>?\@A-Z[\\\]^_`a-z{|}~])/sprintf("=%02X", ord(Encode::encode('iso-8859-1',Encode::decode('posix-bc',$1))))/eg;  # rule #2,#3
-            $res =~ s/([ \t]+)$/
-              join('', map { sprintf("=%02X", ord(Encode::encode('iso-8859-1',Encode::decode('posix-bc',$_)))) }
-        		   split('', $1)
-              )/egm;                        # rule #3 (encode whitespace at eol)
-        }
-        elsif (ord('[') == 186) {
-            $res =~ s/([^ \t\n!"#\$%&'()*+,\-.\/0-9:;<>?\@A-Z[\\\]^_`a-z{|}~])/sprintf("=%02X", ord(Encode::encode('iso-8859-1',Encode::decode('cp37',$1))))/eg;  # rule #2,#3
-            $res =~ s/([ \t]+)$/
-              join('', map { sprintf("=%02X", ord(Encode::encode('iso-8859-1',Encode::decode('cp37',$_)))) }
-        		   split('', $1)
-              )/egm;                        # rule #3 (encode whitespace at eol)
-        }
-    }
-    else { # ASCII style machine
-        $res =~  s/([^ \t\n!"#\$%&'()*+,\-.\/0-9:;<>?\@A-Z[\\\]^_`a-z{|}~])/sprintf("=%02X", ord($1))/eg;  # rule #2,#3
-	$res =~ s/\n/=0A/g unless length($eol);
-        $res =~ s/([ \t]+)$/
-          join('', map { sprintf("=%02X", ord($_)) }
-    		   split('', $1)
-          )/egm;                        # rule #3 (encode whitespace at eol)
-    }
-
-    return $res unless length($eol);
-
-    # rule #5 (lines must be shorter than 76 chars, but we are not allowed
-    # to break =XX escapes.  This makes things complicated :-( )
-    my $brokenlines = "";
-    $brokenlines .= "$1=$eol"
-	while $res =~ s/(.*?^[^\n]{73} (?:
-		 [^=\n]{2} (?! [^=\n]{0,1} $) # 75 not followed by .?\n
-		|[^=\n]    (?! [^=\n]{0,2} $) # 74 not followed by .?.?\n
-		|          (?! [^=\n]{0,3} $) # 73 not followed by .?.?.?\n
-	    ))//xsm;
-    $res =~ s/\n\z/$eol/;
-
-    "$brokenlines$res";
-}
-
-
-sub old_decode_qp ($)
-{
-    my $res = shift;
-    $res =~ s/\r\n/\n/g;            # normalize newlines
-    $res =~ s/[ \t]+\n/\n/g;        # rule #3 (trailing space must be deleted)
-    $res =~ s/=\n//g;               # rule #5 (soft line breaks)
-    if (ord('A') == 193) { # EBCDIC style machine
-        if (ord('[') == 173) {
-            $res =~ s/=([\da-fA-F]{2})/Encode::encode('cp1047',Encode::decode('iso-8859-1',pack("C", hex($1))))/ge;
-        }
-        elsif (ord('[') == 187) {
-            $res =~ s/=([\da-fA-F]{2})/Encode::encode('posix-bc',Encode::decode('iso-8859-1',pack("C", hex($1))))/ge;
-        }
-        elsif (ord('[') == 186) {
-            $res =~ s/=([\da-fA-F]{2})/Encode::encode('cp37',Encode::decode('iso-8859-1',pack("C", hex($1))))/ge;
-        }
-    }
-    else { # ASCII style machine
-        $res =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge;
-    }
-    $res;
-}
-
-# Set up aliases so that these functions also can be called as
-#
-# MIME::QuotedPrint::encode();
-# MIME::QuotedPrint::decode();
-
-*encode = \&encode_qp;
-*decode = \&decode_qp;
-
-1;
diff --git a/ext/MIME/Base64/t/bad-sv.t b/ext/MIME/Base64/t/bad-sv.t
new file mode 100644
index 0000000..3505b80
--- /dev/null
+++ b/ext/MIME/Base64/t/bad-sv.t
@@ -0,0 +1,42 @@
+#!perl -w
+
+BEGIN {
+    eval {
+	require Perl::API;
+    };
+    if ($@) {
+	print "1..0 # skipped: Perl::API needed for this test\n";
+	print $@;
+	exit;
+    }
+}
+
+use strict;
+use Test qw(plan ok);
+use Perl::API qw(SvCUR SvCUR_set SvLEN);
+use MIME::Base64 qw(encode_base64 decode_base64);
+use MIME::QuotedPrint qw(encode_qp decode_qp);
+
+plan tests => 6;
+
+my $a = "abc";
+
+ok(SvCUR($a), 3);
+ok(SvLEN($a), 4);
+
+# Make sure that encode_base64 does not look beyond SvCUR().
+# This was fixed in v2.21.  Valgrind would also show some
+# illegal reads on this.
+
+SvCUR_set($a, 1);
+ok(encode_base64($a), "YQ==\n");
+
+SvCUR_set($a, 4);
+ok(encode_base64($a), "YWJjAA==\n");
+
+ok(encode_qp($a), "abc=00");
+
+$a = "ab\n";
+
+SvCUR_set($a, 2);
+ok(encode_qp($a), "ab");
diff --git a/ext/MIME/Base64/t/base64.t b/ext/MIME/Base64/t/base64.t
index b398131..d446ec2 100644
--- a/ext/MIME/Base64/t/base64.t
+++ b/ext/MIME/Base64/t/base64.t
@@ -336,18 +336,6 @@ sub encodeTest
             print "not ";
 	}
 
-	if (ord('A') != 193) { # perl versions broken on EBCDIC
-	    # Try the old Perl versions too
-	    if ($encoded ne MIME::Base64::old_encode_base64($plain, '')) {
-		print "old_encode_base64 give different result.\n";
-		print "not ";
-	    }
-	    if ($plain ne MIME::Base64::old_decode_base64($encoded)) {
-		print "old_decode_base64 give different result.\n";
-		print "not ";
-	    }
-	}
-		
 	print "ok $testno\n";
 	$testno++;
     }
diff --git a/ext/MIME/Base64/t/warn.t b/ext/MIME/Base64/t/warn.t
new file mode 100644
index 0000000..3a1e651
--- /dev/null
+++ b/ext/MIME/Base64/t/warn.t
@@ -0,0 +1,74 @@
+#!perl -w
+
+BEGIN {
+    if ($ENV{'PERL_CORE'}){
+        chdir 't' if -d 't';
+        @INC = '../lib';
+    }
+}
+
+BEGIN {
+    eval {
+	require warnings;
+    };
+    if ($@) {
+	print "1..0\n";
+	print $@;
+	exit;
+    }
+}
+
+use strict;
+use MIME::Base64 qw(decode_base64);
+
+print "1..1\n";
+
+use warnings;
+
+my @warn;
+$SIG{__WARN__} = sub { push(@warn, @_) };
+
+warn;
+my $a;
+$a = decode_base64("aa");
+$a = decode_base64("a===");
+warn;
+$a = do {
+    no warnings;
+    decode_base64("aa");
+};
+$a = do {
+    no warnings;
+    decode_base64("a===");
+};
+warn;
+$a = do {
+    local $^W;
+    decode_base64("aa");
+};
+$a = do {
+    local $^W;
+    decode_base64("a===");
+};
+warn;
+
+if ($^O eq 'MSWin32') {
+    for (@warn) {
+	s|\\|/|g;
+    }
+}
+
+for (@warn) {
+    print "# $_";
+}
+
+print "not " unless join("", @warn) eq <<"EOT"; print "ok 1\n";
+Warning: something's wrong at $0 line 31.
+Premature end of base64 data at $0 line 33.
+Premature padding of base64 data at $0 line 34.
+Warning: something's wrong at $0 line 35.
+Premature end of base64 data at $0 line 38.
+Premature padding of base64 data at $0 line 42.
+Warning: something's wrong at $0 line 44.
+Warning: something's wrong at $0 line 53.
+EOT