Integrate MIME::Base64 2.16 from CPAN. (Do we really want the

utility scripts?)

p4raw-id: //depot/perl@18642

11 files changed, 354 insertions, 43 deletions

diff --git a/ext/MIME/Base64/Base64.pm b/ext/MIME/Base64/Base64.pm
index 67034189d6..378adf5981 100644
--- a/ext/MIME/Base64/Base64.pm
+++ b/ext/MIME/Base64/Base64.pm
@@ -1,5 +1,5 @@
 #
-# $Id: Base64.pm,v 2.19 2002/12/28 06:32:37 gisle Exp $
+# $Id: Base64.pm,v 2.25 2003/01/05 08:01:33 gisle Exp $
 
 package MIME::Base64;
 
@@ -27,7 +27,9 @@ The following functions are provided:
 
 =over 4
 
-=item encode_base64($str, [$eol])
+=item encode_base64($str)
+
+=item encode_base64($str, $eol);
 
 Encode data by calling the encode_base64() function.  The first
 argument is the string to encode.  The second argument is the line
@@ -112,7 +114,7 @@ of 4 base64 chars:
 
 =head1 COPYRIGHT
 
-Copyright 1995-1999, 2001 Gisle Aas.
+Copyright 1995-1999, 2001-2003 Gisle Aas.
 
 This library is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
@@ -135,7 +137,7 @@ require DynaLoader;
 @ISA = qw(Exporter DynaLoader);
 @EXPORT = qw(encode_base64 decode_base64);
 
-$VERSION = '2.13';
+$VERSION = '2.16';
 
 eval { bootstrap MIME::Base64 $VERSION; };
 if ($@) {
@@ -187,6 +189,7 @@ sub old_decode_base64 ($)
     }
     $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) . $_,
diff --git a/ext/MIME/Base64/Base64.xs b/ext/MIME/Base64/Base64.xs
index 664907948b..e421836203 100644
--- a/ext/MIME/Base64/Base64.xs
+++ b/ext/MIME/Base64/Base64.xs
@@ -1,6 +1,6 @@
-/*
+/* $Id: Base64.xs,v 1.32 2003/01/05 07:49:07 gisle Exp $
 
-Copyright 1997-1999,2001 Gisle Aas
+Copyright 1997-2003 Gisle Aas
 
 This library is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
@@ -35,6 +35,10 @@ extern "C" {
 }
 #endif
 
+#include "patchlevel.h"
+#if PATCHLEVEL <= 4 && !defined(PL_dowarn)
+   #define PL_dowarn dowarn
+#endif
 
 #define MAX_LINE  76 /* size of encoded lines */
 
@@ -65,7 +69,27 @@ static unsigned char index_64[256] = {
     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
 };
 
+#ifdef SvPVbyte
+#   if PERL_REVISION == 5 && PERL_VERSION < 7
+       /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
+#       undef SvPVbyte
+#       define SvPVbyte(sv, lp) \
+          ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
+           ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
+       static char *
+       my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
+       {   
+           sv_utf8_downgrade(sv,0);
+           return SvPV(sv,*lp);
+       }
+#   endif
+#else
+#   define SvPVbyte SvPV
+#endif
 
+#ifndef NATIVE_TO_ASCII
+#   define NATIVE_TO_ASCII(ch) (ch)
+#endif
 
 MODULE = MIME::Base64		PACKAGE = MIME::Base64
 
@@ -85,7 +109,9 @@ encode_base64(sv,...)
 	int chunk;
 
 	CODE:
+#if PERL_REVISION == 5 && PERL_VERSION >= 6
 	sv_utf8_downgrade(sv, FALSE);
+#endif
 	str = SvPV(sv, rlen); /* SvPV(sv, len) gives warning for signed len */
 	len = (SSize_t)rlen;
 
@@ -210,3 +236,179 @@ decode_base64(sv)
 
 	OUTPUT:
 	RETVAL
+
+
+MODULE = MIME::Base64		PACKAGE = MIME::QuotedPrint
+
+#define qp_isplain(c) ((c) == '\t' || ((c) >= ' ' && (c) <= '~') && (c) != '=')
+
+SV*
+encode_qp(sv,...)
+	SV* sv
+	PROTOTYPE: $;$
+
+	PREINIT:
+	char *eol;
+	STRLEN eol_len;
+	STRLEN sv_len;
+	STRLEN linelen;
+	char *beg;
+	char *end;
+	char *p;
+	char *p_beg;
+	STRLEN p_len;
+
+	CODE:
+#if PERL_REVISION == 5 && PERL_VERSION >= 6
+	sv_utf8_downgrade(sv, FALSE);
+#endif
+	/* set up EOL from the second argument if present, default to "\n" */
+	if (items > 1 && SvOK(ST(1))) {
+	    eol = SvPV(ST(1), eol_len);
+	} else {
+	    eol = "\n";
+	    eol_len = 1;
+	}
+
+	beg = SvPV(sv, sv_len);
+	end = beg + sv_len;
+
+	RETVAL = newSV(sv_len + 1);
+	sv_setpv(RETVAL, "");
+	linelen = 0;
+
+	p = beg;
+	while (1) {
+	    p_beg = p;
+
+	    /* skip past as much plain text as possible */
+	    while (p < end && qp_isplain(*p)) {
+	        p++;
+	    }
+	    if (*p == '\n' || p == end) {
+		/* whitespace at end of line must be encoded */
+		while (p > p_beg && (*(p - 1) == '\t' || *(p - 1) == ' '))
+		    p--;
+	    }
+
+	    p_len = p - p_beg;
+	    if (p_len) {
+	        /* output plain text (with line breaks) */
+	        if (eol_len) {
+		    STRLEN max_last_line = (*p == '\n' || p == end)
+					      ? MAX_LINE         /* .......\n */
+					      : (*(p + 1) == '\n' || (p + 1) == end)
+	                                        ? MAX_LINE - 3   /* ....=XX\n */
+	                                        : MAX_LINE - 4;  /* ...=XX=\n */
+		    while (p_len + linelen > max_last_line) {
+			STRLEN len = MAX_LINE - 1 - linelen;
+			if (len > p_len)
+			    len = p_len;
+			sv_catpvn(RETVAL, p_beg, len);
+			p_beg += len;
+			p_len -= len;
+			sv_catpvn(RETVAL, "=", 1);
+			sv_catpvn(RETVAL, eol, eol_len);
+		        linelen = 0;
+		    }
+                }
+		if (p_len) {
+	            sv_catpvn(RETVAL, p_beg, p_len);
+	            linelen += p_len;
+		}
+	    }
+
+	    if (*p == '\n') {
+	        sv_catpvn(RETVAL, eol, eol_len);
+	        p++;
+		linelen = 0;
+	    }
+	    else if (p < end) {
+		/* output escaped char (with line breaks) */
+		if (eol_len && linelen > MAX_LINE - 4) {
+		    sv_catpvn(RETVAL, "=", 1);
+		    sv_catpvn(RETVAL, eol, eol_len);
+		    linelen = 0;
+		}
+	        sv_catpvf(RETVAL, "=%02X", (unsigned char)*p);
+	        p++;
+	        linelen += 3;
+	    }
+	    else {
+		assert(p == end);
+	        break;
+	    }
+
+	    /* optimize reallocs a bit */
+	    if (SvLEN(RETVAL) > 80 && SvLEN(RETVAL) - SvCUR(RETVAL) < 3) {
+		STRLEN expected_len = (SvCUR(RETVAL) * sv_len) / (p - beg);
+     		SvGROW(RETVAL, expected_len);
+	    }
+        }
+
+	OUTPUT:
+	RETVAL
+
+SV*
+decode_qp(sv)
+	SV* sv
+	PROTOTYPE: $
+
+        PREINIT:
+	STRLEN len;
+	char *str = (unsigned char*)SvPVbyte(sv, len);
+	char const* end = str + len;
+	char *r;
+	char *whitespace = 0;
+
+        CODE:
+	RETVAL = newSV(len ? len : 1);
+        SvPOK_on(RETVAL);
+        r = SvPVX(RETVAL);
+	while (str < end) {
+	    if (*str == ' ' || *str == '\t') {
+		if (!whitespace)
+		    whitespace = str;
+		str++;
+	    }
+	    else if (*str == '\r' && (str + 1) < end && str[1] == '\n') {
+		str++;
+	    }
+	    else if (*str == '\n') {
+		whitespace = 0;
+		*r++ = *str++;
+	    }
+	    else {
+		if (whitespace) {
+		    while (whitespace < str) {
+			*r++ = *whitespace++;
+		    }
+		    whitespace = 0;
+                }
+            	if (*str == '=' && (str + 2) < end && isxdigit(str[1]) && isxdigit(str[2])) {
+	            char buf[3];
+                    str++;
+	            buf[0] = *str++;
+		    buf[1] = *str++;
+	            buf[2] = '\0';
+		    *r++ = (char)strtol(buf, 0, 16);
+	        }
+		else if (*str == '=' && (str + 1) < end && str[1] == '\n') {
+		    str += 2;
+		}
+		else if (*str == '=' && (str + 2) < end && str[1] == '\r' && str[2] == '\n') {
+		    str += 3;
+		}
+	    	else {
+	            *r++ = *str++;
+                }
+	    }
+	}
+	*r = '\0';
+	SvCUR_set(RETVAL, r - SvPVX(RETVAL));
+
+        OUTPUT:
+	RETVAL
+
+
+MODULE = MIME::Base64		PACKAGE = MIME::Base64
diff --git a/ext/MIME/Base64/Changes b/ext/MIME/Base64/Changes
index a462317632..fab3cca66e 100644
--- a/ext/MIME/Base64/Changes
+++ b/ext/MIME/Base64/Changes
@@ -1,4 +1,50 @@
-2002-02-27   Gisle Aas <gisle@ActiveState.com>
+2003-01-05   Gisle Aas <gisle@ActiveState.com>
+
+   Release 2.16
+
+   Fixed the encode_qp() line breaking code.  It sometimes
+   made lines longer than 76 chars and it could even get into
+   an infinite loop on certain inputs.
+
+
+
+2003-01-03   Gisle Aas <gisle@ActiveState.com>
+
+   Release 2.15
+
+   Fixed the XS based decode_qp() for strings where a =XX
+   sequence was followed by digits.
+
+   Faster encode_qp() for long strings with lots of chars
+   that need escaping.
+
+   The old_decode_base64() function introduced in 2.13
+   was returning undef for empty input on olders perls.
+   This problem has been fixed.
+
+
+
+2003-01-01   Gisle Aas <gisle@ActiveState.com>
+
+   Release 2.14
+
+   MIME::QuotedPrint functions now also implemented using XS
+   which make them faster.  2-3 times faster when encoding line by
+   line and as much as 200 times faster on long binary input.  There
+   is probably some breakage on non-ASCII systems from this.
+
+   The encode_qp() function now takes an $eol argument in the
+   same way as encode_base64() does.
+
+   Slight change in behaviour: the decode_qp() function now turns
+   \r\n terminated lines into \n terminated lines.  This makes is
+   more likely that encode_qp(decode_qp()) round-trip properly.
+
+   Included {en,de}code-{base64,qp} utility scripts.
+
+
+
+2002-12-27   Gisle Aas <gisle@ActiveState.com>
 
    Release 2.13
 
diff --git a/ext/MIME/Base64/Makefile.PL b/ext/MIME/Base64/Makefile.PL
index da37853cc7..93e30806ec 100644
--- a/ext/MIME/Base64/Makefile.PL
+++ b/ext/MIME/Base64/Makefile.PL
@@ -3,7 +3,7 @@ use ExtUtils::MakeMaker;
 
 WriteMakefile(
     NAME	 => 'MIME::Base64',
-    MAN3PODS    => {},  # Pods will be built by installman.
     VERSION_FROM => 'Base64.pm',
+    EXE_FILES    => [qw(encode-base64 decode-base64 encode-qp decode-qp)],
     dist         => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
 );
diff --git a/ext/MIME/Base64/QuotedPrint.pm b/ext/MIME/Base64/QuotedPrint.pm
index c2d4cbf7d4..778cdab0df 100644
--- a/ext/MIME/Base64/QuotedPrint.pm
+++ b/ext/MIME/Base64/QuotedPrint.pm
@@ -1,5 +1,5 @@
 #
-# $Id: QuotedPrint.pm,v 2.4 2002/12/28 05:50:05 gisle Exp $
+# $Id: QuotedPrint.pm,v 2.11 2003/01/05 08:01:33 gisle Exp $
 
 package MIME::QuotedPrint;
 
@@ -31,17 +31,16 @@ The following functions are provided:
 
 =item encode_qp($str)
 
-This function will return an encoded version of the string given as
-argument.
+=item encode_qp($str, $eol)
 
-Note that encode_qp() does not change newlines C<"\n"> to the CRLF
-sequence even though this might be considered the right thing to do
-(RFC 2045 (Q-P Rule #4)).
+This function will return an encoded version of the string given as
+argument.  The second argument is the line ending sequence to use (it
+is optional and defaults to C<"\n">).
 
 =item decode_qp($str);
 
 This function will return the plain text version of the string given
-as argument.
+as argument.  Lines with be "\n" terminated.
 
 =back
 
@@ -55,7 +54,7 @@ call them as:
 
 =head1 COPYRIGHT
 
-Copyright 1995-1997 Gisle Aas.
+Copyright 1995-1997,2002-2003 Gisle Aas.
 
 This library is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
@@ -74,9 +73,15 @@ require Exporter;
 
 use Carp qw(croak);
 
-$VERSION = sprintf("%d.%02d", q$Revision: 2.4 $ =~ /(\d+)\.(\d+)/);
+$VERSION = "2.16";
 
-sub encode_qp ($)
+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) {
@@ -87,6 +92,9 @@ sub encode_qp ($)
 	}
     }
 
+    my $eol = shift;
+    $eol = "\n" unless defined($eol) || length($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
@@ -123,7 +131,7 @@ sub encode_qp ($)
     # 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=\n"
+    $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
@@ -134,11 +142,12 @@ sub encode_qp ($)
 }
 
 
-sub decode_qp ($)
+sub old_decode_qp ($)
 {
     my $res = shift;
-    $res =~ s/[ \t]+?(\r?\n)/$1/g;  # rule #3 (trailing space must be deleted)
-    $res =~ s/=\r?\n//g;            # rule #5 (soft line breaks)
+    $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;
diff --git a/ext/MIME/Base64/decode-base64 b/ext/MIME/Base64/decode-base64
new file mode 100755
index 0000000000..5c13c244dc
--- /dev/null
+++ b/ext/MIME/Base64/decode-base64
@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+
+use MIME::Base64 qw(decode_base64);
+
+while (<>) {
+    print decode_base64($_);
+}
+
diff --git a/ext/MIME/Base64/decode-qp b/ext/MIME/Base64/decode-qp
new file mode 100755
index 0000000000..6b9663ca5a
--- /dev/null
+++ b/ext/MIME/Base64/decode-qp
@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+
+use MIME::QuotedPrint qw(decode_qp);
+
+while (<>) {
+    print decode_qp($_);
+}
+
diff --git a/ext/MIME/Base64/encode-base64 b/ext/MIME/Base64/encode-base64
new file mode 100755
index 0000000000..0ee70f87e3
--- /dev/null
+++ b/ext/MIME/Base64/encode-base64
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+
+use MIME::Base64 qw(encode_base64);
+
+my $buf = "";
+while (<>) {
+    $buf .= $_;
+    if (length($buf) >= 57) {
+	print encode_base64(substr($buf, 0, int(length($buf) / 57) * 57, ""));
+    }
+}
+
+print encode_base64($buf);
diff --git a/ext/MIME/Base64/encode-qp b/ext/MIME/Base64/encode-qp
new file mode 100755
index 0000000000..7ceed3ecd7
--- /dev/null
+++ b/ext/MIME/Base64/encode-qp
@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+
+use MIME::QuotedPrint qw(encode_qp);
+
+while (<>) {
+    print encode_qp($_);
+}
+
diff --git a/ext/MIME/Base64/t/base64.t b/ext/MIME/Base64/t/base64.t
index 08bdea003b..b398131981 100644
--- a/ext/MIME/Base64/t/base64.t
+++ b/ext/MIME/Base64/t/base64.t
@@ -337,15 +337,15 @@ sub encodeTest
 	}
 
 	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 ";
-        }
+	    # 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";
diff --git a/ext/MIME/Base64/t/quoted-print.t b/ext/MIME/Base64/t/quoted-print.t
index 395958ee21..66427246e1 100644
--- a/ext/MIME/Base64/t/quoted-print.t
+++ b/ext/MIME/Base64/t/quoted-print.t
@@ -25,8 +25,8 @@ $x70 = "x" x 70;
    ["test  \ntest\n\t \t \n" => "test=20=20\ntest\n=09=20=09=20\n"],
 
    # "=" is special an should be decoded
-   ["=\n" => "=3D\n"],
-   ["\0\xff" => "=00=FF"],
+   ["=30\n" => "=3D30\n"],
+   ["\0\xff0" => "=00=FF0"],
 
    # Very long lines should be broken (not more than 76 chars
    ["The Quoted-Printable encoding is intended to represent data that largly consists of octets that correspond to printable characters in the ASCII character set." =>
@@ -57,20 +57,34 @@ y. -- H. L. Mencken"],
    ["$x70!234"		=> "$x70!234"],
    ["$x70!2345"		=> "$x70!2345"],
    ["$x70!23456"	=> "$x70!23456"],
+   ["$x70!234567"	=> "$x70!2345=\n67"],
+   ["$x70!23456="	=> "$x70!2345=\n6=3D"],
    ["$x70!23\n"		=> "$x70!23\n"],
    ["$x70!234\n"	=> "$x70!234\n"],
    ["$x70!2345\n"	=> "$x70!2345\n"],
    ["$x70!23456\n"	=> "$x70!23456\n"],
+   ["$x70!234567\n"	=> "$x70!2345=\n67\n"],
+   ["$x70!23456=\n"	=> "$x70!2345=\n6=3D\n"],
 
    # Not allowed to break =XX escapes using soft line break
-   ["$x70===xxxx" => "$x70=3D=\n=3D=3Dxxxx"],
-   ["$x70!===xxx" => "$x70!=3D=\n=3D=3Dxxx"],
-   ["$x70!!===xx" => "$x70!!=3D=\n=3D=3Dxx"],
-   ["$x70!!!===x" => "$x70!!!=\n=3D=3D=3Dx"],
-   #                            ^
-   #                    70123456|
-   #                           max
-   #                        line width
+   ["$x70===xxxxx"  => "$x70=3D=\n=3D=3Dxxxxx"],
+   ["$x70!===xxxx"  => "$x70!=3D=\n=3D=3Dxxxx"],
+   ["$x70!2===xxx"  => "$x70!2=3D=\n=3D=3Dxxx"],
+   ["$x70!23===xx"  => "$x70!23=\n=3D=3D=3Dxx"],
+   ["$x70!234===x"  => "$x70!234=\n=3D=3D=3Dx"],
+   ["$x70!2=\n"     => "$x70!2=3D\n"],
+   ["$x70!23=\n"    => "$x70!23=\n=3D\n"],
+   ["$x70!234=\n"   => "$x70!234=\n=3D\n"],
+   ["$x70!2345=\n"  => "$x70!2345=\n=3D\n"],
+   ["$x70!23456=\n" => "$x70!2345=\n6=3D\n"],
+   #                              ^
+   #                      70123456|
+   #                             max
+   #                          line width
+
+   # some extra special cases we have had problems with
+   ["$x70!2=x=x" => "$x70!2=3D=\nx=3Dx"],
+   ["$x70!2345$x70!2345$x70!23456\n", "$x70!2345=\n$x70!2345=\n$x70!23456\n"],
 );
 
 $notests = @tests + 3;
@@ -110,8 +124,8 @@ $testno++; print "ok $testno\n";
 
 # Same test but with "\r\n" terminated lines
 print "not " unless decode_qp("foo  \r\n\r\nfoo =\r\n\r\nfoo=20\r\n\r\n") eq
-                                "foo\r\n\r\nfoo \r\nfoo \r\n\r\n";
+                                "foo\n\nfoo \nfoo \n\n";
 $testno++; print "ok $testno\n";
 
-print "not " if $] >= 5.006 && (eval 'encode_qp("XXX \x{100}")' || $@ !~ /^The Quoted-Printable encoding is only defined for bytes/);
+print "not " if $] >= 5.006 && (eval 'encode_qp("XXX \x{100}")' || !$@);
 $testno++; print "ok $testno\n";