Update for ext/MIME/Base64/

Message-ID: <lrhecvzfjp.fsf@caliper.activestate.com>

p4raw-id: //depot/perl@18493

diff --git a/ext/MIME/Base64/Base64.pm b/ext/MIME/Base64/Base64.pm
index 29fb7d5..6703418 100644 (file)
--- a/ext/MIME/Base64/Base64.pm
+++ b/ext/MIME/Base64/Base64.pm
@@ -1,5 +1,5 @@
 #
-# $Id: Base64.pm,v 2.16 2001/02/24 06:28:10 gisle Exp $
+# $Id: Base64.pm,v 2.19 2002/12/28 06:32:37 gisle Exp $
 
 package MIME::Base64;
 
@@ -135,7 +135,7 @@ require DynaLoader;
 @ISA = qw(Exporter DynaLoader);
 @EXPORT = qw(encode_base64 decode_base64);
 
-$VERSION = '2.12';
+$VERSION = '2.13';
 
 eval { bootstrap MIME::Base64 $VERSION; };
 if ($@) {
@@ -155,12 +155,13 @@ use integer;
 
 sub old_encode_base64 ($;$)
 {
-    my $res = "";
     my $eol = $_[1];
     $eol = "\n" unless defined $eol;
-    pos($_[0]) = 0;                          # ensure start at the beginning
 
-    $res = join '', map( pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs));
+    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
@@ -187,8 +188,22 @@ sub old_decode_base64 ($)
     $str =~ s/=+$//;                        # remove padding
     $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format
 
-    return join'', map( unpack("u", chr(32 + length($_)*3/4) . $_),
-                       $str =~ /(.{1,60})/gs);
+    ## 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

diff --git a/ext/MIME/Base64/Changes b/ext/MIME/Base64/Changes
index 10cd3ce..a462317 100644 (file)
--- a/ext/MIME/Base64/Changes
+++ b/ext/MIME/Base64/Changes
@@ -1,3 +1,19 @@
+2002-02-27   Gisle Aas <gisle@ActiveState.com>
+
+   Release 2.13
+
+   Sync up with bleadperl:
+       - Documentation update
+       - EBCDIC support
+       - Whitespace tweaks
+       - Improved Unicode support
+       - Test suite tweaks
+
+   Improved version of the old_{en,de}code_base64 functions
+   contributed by Paul Szabo <psz@maths.usyd.edu.au>.
+
+
+
 2001-02-23   Gisle Aas <gisle@ActiveState.com>
 
    Release 2.12

diff --git a/ext/MIME/Base64/QuotedPrint.pm b/ext/MIME/Base64/QuotedPrint.pm
index 2cdc018..c2d4cbf 100644 (file)
--- a/ext/MIME/Base64/QuotedPrint.pm
+++ b/ext/MIME/Base64/QuotedPrint.pm
@@ -1,5 +1,5 @@
 #
-# $Id: QuotedPrint.pm,v 2.3 1997/12/02 10:24:27 aas Exp $
+# $Id: QuotedPrint.pm,v 2.4 2002/12/28 05:50:05 gisle Exp $
 
 package MIME::QuotedPrint;
 
@@ -74,13 +74,18 @@ require Exporter;
 
 use Carp qw(croak);
 
-$VERSION = sprintf("%d.%02d", q$Revision: 2.3 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 2.4 $ =~ /(\d+)\.(\d+)/);
 
 sub encode_qp ($)
 {
     my $res = shift;
-    croak("The Quoted-Printable encoding is only defined for bytes")
-       if $res =~ /[^\0-\xFF]/;
+    if ($] >= 5.006) {
+       require bytes;
+       if (bytes::length($res) > length($res) ||
+           ($] >= 5.008 && $res =~ /[^\0-\xFF]/)) {
+           croak("The Quoted-Printable encoding is only defined for bytes");
+       }
+    }
 
     # 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('<')).

diff --git a/ext/MIME/Base64/t/quoted-print.t b/ext/MIME/Base64/t/quoted-print.t
index 97e525e..395958e 100644 (file)
--- a/ext/MIME/Base64/t/quoted-print.t
+++ b/ext/MIME/Base64/t/quoted-print.t
@@ -1,6 +1,8 @@
 BEGIN {
-        chdir 't' if -d 't';
-        @INC = '../lib';
+        if ($ENV{PERL_CORE}) {
+                chdir 't' if -d 't';
+                @INC = '../lib';
+        }
 }
 
 use MIME::QuotedPrint;
@@ -111,5 +113,5 @@ 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";
 $testno++; print "ok $testno\n";
 
-print "not " if 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}")' || $@ !~ /^The Quoted-Printable encoding is only defined for bytes/);
 $testno++; print "ok $testno\n";

diff --git a/ext/MIME/Base64/t/unicode.t b/ext/MIME/Base64/t/unicode.t
index 0b8df1a..8037440 100644 (file)
--- a/ext/MIME/Base64/t/unicode.t
+++ b/ext/MIME/Base64/t/unicode.t
@@ -1,6 +1,12 @@
 BEGIN {
-        chdir 't' if -d 't';
-        @INC = '../lib';
+       unless ($] >= 5.006) {
+               print "1..0\n";
+               exit(0);
+       }
+        if ($ENV{PERL_CORE}) {
+                chdir 't' if -d 't';
+                @INC = '../lib';
+        }
 }
 
 print "1..1\n";