Add MIME::Base 2.12 from Gisle Aas, version number bumped to 2.13.
Jarkko Hietaniemi [Sun, 25 Mar 2001 03:58:53 +0000 (03:58 +0000)]
p4raw-id: //depot/perl@9334

MANIFEST
ext/MIME/Base64/Base64.pm [new file with mode: 0644]
ext/MIME/Base64/Base64.xs [new file with mode: 0644]
ext/MIME/Base64/Changes [new file with mode: 0644]
ext/MIME/Base64/Makefile.PL [new file with mode: 0644]
ext/MIME/Base64/QuotedPrint.pm [new file with mode: 0644]
t/lib/mimeb64.t [new file with mode: 0644]
t/lib/mimeb64u.t [new file with mode: 0644]
t/lib/mimeqp.t [new file with mode: 0644]

index 7537c08..0eb7845 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -359,6 +359,11 @@ ext/IPC/SysV/hints/cygwin.pl       Hint for IPC::SysV for named architecture
 ext/IPC/SysV/hints/next_3.pl   Hint for IPC::SysV for named architecture
 ext/IPC/SysV/t/msg.t           IPC::SysV extension Perl module
 ext/IPC/SysV/t/sem.t           IPC::SysV extension Perl module
+ext/MIME/Base64/Base64.pm      MIME::Base64 extension
+ext/MIME/Base64/Base64.xs      MIME::Base64 extension
+ext/MIME/Base64/Changes                MIME::Base64 extension
+ext/MIME/Base64/Makefile.PL    MIME::Base64 extension
+ext/MIME/Base64/QuotedPrint.pm MIME::Base64 extension
 ext/NDBM_File/Makefile.PL      NDBM extension makefile writer
 ext/NDBM_File/NDBM_File.pm     NDBM extension Perl module
 ext/NDBM_File/NDBM_File.xs     NDBM extension external subroutines
@@ -1501,6 +1506,9 @@ t/lib/lc-uk.t     See if Locale::Codes work
 t/lib/md5-aaa.t        See if Digest::MD5 extension works
 t/lib/md5-badf.t       See if Digest::MD5 extension works
 t/lib/md5-file.t       See if Digest::MD5 extension works
+t/lib/mimeb64.t                        see whether MIME::Base64 works
+t/lib/mimeb64u.t               see whether MIME::Base64 works
+t/lib/mimeqp.t         see whether MIME::QuotedPrint works
 t/lib/ndbm.t           See if NDBM_File works
 t/lib/net-hostent.t    See if Net::hostent works
 t/lib/odbm.t           See if ODBM_File works
diff --git a/ext/MIME/Base64/Base64.pm b/ext/MIME/Base64/Base64.pm
new file mode 100644 (file)
index 0000000..af13589
--- /dev/null
@@ -0,0 +1,202 @@
+#
+# $Id: Base64.pm,v 2.16 2001/02/24 06:28:10 gisle Exp $
+
+package MIME::Base64;
+
+=head1 NAME
+
+MIME::Base64 - Encoding and decoding of base64 strings
+
+=head1 SYNOPSIS
+
+ use MIME::Base64;
+
+ $encoded = encode_base64('Aladdin:open sesame');
+ $decoded = decode_base64($encoded);
+
+=head1 DESCRIPTION
+
+This module provides functions to encode and decode strings into the
+Base64 encoding specified in RFC 2045 - I<MIME (Multipurpose Internet
+Mail Extensions)>. The Base64 encoding is designed to represent
+arbitrary sequences of octets in a form that need not be humanly
+readable. A 65-character subset ([A-Za-z0-9+/=]) of US-ASCII is used,
+enabling 6 bits to be represented per printable character.
+
+The following functions are provided:
+
+=over 4
+
+=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
+ending sequence to use (it is optional and defaults to C<"\n">).  The
+returned encoded string is broken into lines of no more than 76
+characters each and it will end with $eol unless it is empty.  Pass an
+empty string as second argument if you do not want the encoded string
+broken into lines.
+
+=item decode_base64($str)
+
+Decode a base64 string by calling the decode_base64() function.  This
+function takes a single argument which is the string to decode and
+returns the decoded data.
+
+Any character not part of the 65-character base64 subset set is
+silently ignored.  Characters occuring after a '=' padding character
+are never decoded.
+
+If the length of the string to decode (after ignoring
+non-base64 chars) is not a multiple of 4 or padding occurs too ealy,
+then a warning is generated if perl is running under C<-w>.
+
+=back
+
+If you prefer not to import these routines into your namespace you can
+call them as:
+
+    use MIME::Base64 ();
+    $encoded = MIME::Base64::encode($decoded);
+    $decoded = MIME::Base64::decode($encoded);
+
+=head1 DIAGNOSTICS
+
+The following warnings might be generated if perl is invoked with the
+C<-w> switch:
+
+=over 4
+
+=item Premature end of base64 data
+
+The number of characters to decode is not a multiple of 4.  Legal
+base64 data should be padded with one or two "=" characters to make
+its length a multiple of 4.  The decoded result will anyway be as if
+the padding was there.
+
+=item Premature padding of base64 data
+
+The '=' padding character occurs as the first or second character
+in a base64 quartet.
+
+=back
+
+=head1 EXAMPLES
+
+If you want to encode a large file, you should encode it in chunks
+that are a multiple of 57 bytes.  This ensures that the base64 lines
+line up and that you do not end up with padding in the middle. 57
+bytes of data fills one complete base64 line (76 == 57*4/3):
+
+   use MIME::Base64 qw(encode_base64);
+
+   open(FILE, "/var/log/wtmp") or die "$!";
+   while (read(FILE, $buf, 60*57)) {
+       print encode_base64($buf);
+   }
+
+or if you know you have enough memory
+
+   use MIME::Base64 qw(encode_base64);
+   local($/) = undef;  # slurp
+   print encode_base64(<STDIN>);
+
+The same approach as a command line:
+
+   perl -MMIME::Base64 -0777 -ne 'print encode_base64($_)' <file
+
+Decoding does not need slurp mode if all the lines contains a multiple
+of 4 base64 chars:
+
+   perl -MMIME::Base64 -ne 'print decode_base64($_)' <file
+
+=head1 COPYRIGHT
+
+Copyright 1995-1999, 2001 Gisle Aas.
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+Distantly based on LWP::Base64 written by Martijn Koster
+<m.koster@nexor.co.uk> and Joerg Reichelt <j.reichelt@nexor.co.uk> and
+code posted to comp.lang.perl <3pd2lp$6gf@wsinti07.win.tue.nl> by Hans
+Mulder <hansm@wsinti07.win.tue.nl>
+
+The XS implementation use code from metamail.  Copyright 1991 Bell
+Communications Research, Inc. (Bellcore)
+
+=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.13';
+
+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.
+
+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));
+
+    $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]
+
+    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 join'', map( unpack("u", chr(32 + length($_)*3/4) . $_),
+                       $str =~ /(.{1,60})/gs);
+}
+
+# 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
new file mode 100644 (file)
index 0000000..118d170
--- /dev/null
@@ -0,0 +1,218 @@
+/* $Id: Base64.xs,v 1.18 2001/02/24 06:27:01 gisle Exp $
+
+Copyright 1997-1999,2001 Gisle Aas
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+
+The tables and some of the code that used to be here was borrowed from
+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", 
+  WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
+
+*/
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#ifdef __cplusplus
+}
+#endif
+
+#include "patchlevel.h"
+#if PATCHLEVEL <= 4 && !defined(PL_dowarn)
+   #define PL_dowarn dowarn
+#endif
+
+#define MAX_LINE  76 /* size of encoded lines */
+
+static char basis_64[] =
+   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
+
+#define XX      255    /* illegal base64 char */
+#define EQ      254    /* padding */
+#define INVALID XX
+
+static unsigned char index_64[256] = {
+    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
+    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
+    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,62, XX,XX,XX,63,
+    52,53,54,55, 56,57,58,59, 60,61,XX,XX, XX,EQ,XX,XX,
+    XX, 0, 1, 2,  3, 4, 5, 6,  7, 8, 9,10, 11,12,13,14,
+    15,16,17,18, 19,20,21,22, 23,24,25,XX, XX,XX,XX,XX,
+    XX,26,27,28, 29,30,31,32, 33,34,35,36, 37,38,39,40,
+    41,42,43,44, 45,46,47,48, 49,50,51,XX, XX,XX,XX,XX,
+
+    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
+    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
+    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
+    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
+    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
+    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
+    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
+    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
+};
+
+
+
+MODULE = MIME::Base64          PACKAGE = MIME::Base64
+
+SV*
+encode_base64(sv,...)
+       SV* sv
+       PROTOTYPE: $;$
+
+       PREINIT:
+       char *str;     /* string to encode */
+       SSize_t len;   /* length of the string */
+       char *eol;     /* the end-of-line sequence to use */
+       STRLEN eollen; /* length of the EOL sequence */
+       char *r;       /* result string */
+       STRLEN rlen;   /* length of result string */
+       unsigned char c1, c2, c3;
+       int chunk;
+
+       CODE:
+#ifdef sv_utf8_downgrade
+       sv_utf8_downgrade(sv, FALSE);
+#endif
+       str = SvPV(sv, rlen); /* SvPV(sv, len) gives warning for signed len */
+       len = (SSize_t)rlen;
+
+       /* set up EOL from the second argument if present, default to "\n" */
+       if (items > 1 && SvOK(ST(1))) {
+           eol = SvPV(ST(1), eollen);
+       } else {
+           eol = "\n";
+           eollen = 1;
+       }
+
+       /* calculate the length of the result */
+       rlen = (len+2) / 3 * 4;  /* encoded bytes */
+       if (rlen) {
+           /* add space for EOL */
+           rlen += ((rlen-1) / MAX_LINE + 1) * eollen;
+       }
+
+       /* allocate a result buffer */
+       RETVAL = newSV(rlen ? rlen : 1);
+       SvPOK_on(RETVAL);       
+       SvCUR_set(RETVAL, rlen);
+       r = SvPVX(RETVAL);
+
+       /* encode */
+       for (chunk=0; len > 0; len -= 3, chunk++) {
+           if (chunk == (MAX_LINE/4)) {
+               char *c = eol;
+               char *e = eol + eollen;
+               while (c < e)
+                   *r++ = *c++;
+               chunk = 0;
+           }
+           c1 = *str++;
+           c2 = *str++;
+           *r++ = basis_64[c1>>2];
+           *r++ = basis_64[((c1 & 0x3)<< 4) | ((c2 & 0xF0) >> 4)];
+           if (len > 2) {
+               c3 = *str++;
+               *r++ = basis_64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)];
+               *r++ = basis_64[c3 & 0x3F];
+           } else if (len == 2) {
+               *r++ = basis_64[(c2 & 0xF) << 2];
+               *r++ = '=';
+           } else { /* len == 1 */
+               *r++ = '=';
+               *r++ = '=';
+           }
+       }
+       if (rlen) {
+           /* append eol to the result string */
+           char *c = eol;
+           char *e = eol + eollen;
+           while (c < e)
+               *r++ = *c++;
+       }
+       *r = '\0';  /* every SV in perl should be NUL-terminated */
+
+       OUTPUT:
+       RETVAL
+
+SV*
+decode_base64(sv)
+       SV* sv
+       PROTOTYPE: $
+
+       PREINIT:
+       STRLEN len;
+       register unsigned char *str = (unsigned char*)SvPV(sv, len);
+       unsigned char const* end = str + len;
+       char *r;
+       unsigned char c[4];
+
+       CODE:
+       {
+           /* always enough, but might be too much */
+           STRLEN rlen = len * 3 / 4;
+           RETVAL = newSV(rlen ? rlen : 1);
+       }
+        SvPOK_on(RETVAL);
+        r = SvPVX(RETVAL);
+
+       while (str < end) {
+           int i = 0;
+            do {
+               unsigned char uc = index_64[*str++];
+               if (uc != INVALID)
+                   c[i++] = uc;
+
+               if (str == end) {
+                   if (i < 4) {
+                       if (i && PL_dowarn)
+                           warn("Premature end of base64 data");
+                       if (i < 2) goto thats_it;
+                       if (i == 2) c[2] = EQ;
+                       c[3] = EQ;
+                   }
+                   break;
+               }
+            } while (i < 4);
+           
+           if (c[0] == EQ || c[1] == EQ) {
+               if (PL_dowarn) warn("Premature padding of base64 data");
+               break;
+            }
+           /* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);/**/
+
+           *r++ = (c[0] << 2) | ((c[1] & 0x30) >> 4);
+
+           if (c[2] == EQ)
+               break;
+           *r++ = ((c[1] & 0x0F) << 4) | ((c[2] & 0x3C) >> 2);
+
+           if (c[3] == EQ)
+               break;
+           *r++ = ((c[2] & 0x03) << 6) | c[3];
+       }
+
+      thats_it:
+       SvCUR_set(RETVAL, r - SvPVX(RETVAL));
+       *r = '\0';
+
+       OUTPUT:
+       RETVAL
diff --git a/ext/MIME/Base64/Changes b/ext/MIME/Base64/Changes
new file mode 100644 (file)
index 0000000..10cd3ce
--- /dev/null
@@ -0,0 +1,132 @@
+2001-02-23   Gisle Aas <gisle@ActiveState.com>
+
+   Release 2.12
+
+   Speed up pure perl base64 encoder/decoder by using join/map instead
+   of while loop.  Contributed by Arno Beckmann <arno@gmx.de>
+
+   Doc update contributed by Jerrad Pierce <belg4mit@CALLOWAY.MIT.EDU>
+
+   Downgrade UTF8 strings before starting to encode.
+
+
+
+1999-02-27   Gisle Aas <gisle@aas.no>
+
+   Release 2.11
+
+   Fixed bogus "Premature end of base64 data" warning.  Bug spotted
+   by Dwayne Jacques Fontenot.
+
+   Workaround for Redhat shipping trial releases of perl.
+
+
+
+1998-12-18   Gisle Aas <aas@sn.no>
+
+   Release 2.10
+
+   A tweak that should make compilation with some old perl5.00[23]
+   perls better.
+
+   A cast that make some compilers more happy.
+
+
+
+1998-11-13   Gisle Aas <aas@sn.no>
+
+   Release 2.09
+
+   The 2.08 release did not compile with perl5.005_53, because
+   all simple globals now need to be prefixed with "PL_".
+
+
+
+1998-10-22   Gisle Aas <aas@sn.no>
+
+   Release 2.08
+
+   Found another tweak to speed up decode_base64() with another 3%.
+
+   Improved MIME::Base64 documentation a little.
+
+
+
+1998-10-21   Gisle Aas <aas@sn.no>
+
+   Release 2.07
+
+   Faster and smarter C implementation of the decode_base64()
+   function.  The new decode_base64() was 25% faster when tested
+   on Linux, i586, gcc -O2.
+
+
+
+1998-07-15   Gisle Aas <aas@sn.no>
+
+   Release 2.06
+
+   The decode_base64() implemented in pure perl will only carp
+   (not croak) if length of data to decode is not a multiple 4.  This
+   actually made 'make test' fail after 'rm Base64.xs'.
+
+
+
+1998-01-27   Gisle Aas <aas@sn.no>
+
+   Release 2.05
+
+   The decode_base64() would previously allocate a too short buffer for the
+   result string when the trailing "==" padding was missing in the string to
+   be decoded.
+
+   The encode_base64() now allocate one byte less space in the result
+   strings returned.
+
+
+
+1997-12-02   Gisle Aas <aas@sn.no>
+
+   Release 2.04
+
+   Documentation expanded a bit.
+
+
+
+1997-07-10   Gisle Aas <aas@sn.no>
+
+   Release 2.03
+
+   Decode_base64() doesn't croak on premature ended data any more.
+   A warning is generated instead if running under -w.
+   
+
+
+1997-06-27   Gisle Aas <aas@sn.no>
+
+   Release 2.02
+
+   QuotedPrint fix by Roderick Schertler <roderick@argon.org>:
+
+      - Long lines were not broken unless they're at the beginning
+        of the text
+
+      - Lines near but not over 76 chars were broken when they
+        shouldn't be
+
+
+
+1997-06-13   Gisle Aas <aas@sn.no>
+
+   Release 2.01
+
+   Base64.xs: Avoid type convertion warnings with some compilers
+
+   Minor documentation updates
+
+
+
+1997-04-24   Gisle Aas <aas@sn.no>
+
+   Release 2.00, based on libwww-perl-5.08.
+
diff --git a/ext/MIME/Base64/Makefile.PL b/ext/MIME/Base64/Makefile.PL
new file mode 100644 (file)
index 0000000..f5b4cb9
--- /dev/null
@@ -0,0 +1,8 @@
+require 5.002;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME        => 'MIME::Base64',
+    VERSION_FROM => 'Base64.pm',
+    dist         => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+);
diff --git a/ext/MIME/Base64/QuotedPrint.pm b/ext/MIME/Base64/QuotedPrint.pm
new file mode 100644 (file)
index 0000000..ccdee2b
--- /dev/null
@@ -0,0 +1,115 @@
+#
+# $Id: QuotedPrint.pm,v 2.3 1997/12/02 10:24:27 aas Exp $
+
+package MIME::QuotedPrint;
+
+=head1 NAME
+
+MIME::QuotedPrint - Encoding and decoding of quoted-printable strings
+
+=head1 SYNOPSIS
+
+ use MIME::QuotedPrint;
+
+ $encoded = encode_qp($decoded);
+ $decoded = decode_qp($encoded);
+
+=head1 DESCRIPTION
+
+This module provides functions to encode and decode strings into the
+Quoted-Printable encoding specified in RFC 2045 - I<MIME (Multipurpose
+Internet Mail Extensions)>.  The Quoted-Printable encoding is intended
+to represent data that largely consists of bytes that correspond to
+printable characters in the ASCII character set.  Non-printable
+characters (as defined by english americans) are represented by a
+triplet consisting of the character "=" followed by two hexadecimal
+digits.
+
+The following functions are provided:
+
+=over 4
+
+=item encode_qp($str)
+
+This function will return an encoded version of the string given as
+argument.
+
+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)).
+
+=item decode_qp($str);
+
+This function will return the plain text version of the string given
+as argument.
+
+=back
+
+
+If you prefer not to import these routines into your namespace you can
+call them as:
+
+  use MIME::QuotedPrint ();
+  $encoded = MIME::QuotedPrint::encode($decoded);
+  $decoded = MIME::QuotedPrint::decode($encoded);
+
+=head1 COPYRIGHT
+
+Copyright 1995-1997 Gisle Aas.
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
+
+use strict;
+use vars qw(@ISA @EXPORT $VERSION);
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(encode_qp decode_qp);
+
+$VERSION = sprintf("%d.%02d", q$Revision: 2.3 $ =~ /(\d+)\.(\d+)/);
+
+
+sub encode_qp ($)
+{
+    my $res = shift;
+    $res =~ s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg;  # rule #2,#3
+    $res =~ s/([ \t]+)$/
+      join('', map { sprintf("=%02X", ord($_)) }
+                  split('', $1)
+      )/egm;                        # rule #3 (encode whitespace at 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=\n"
+       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;
+
+    "$brokenlines$res";
+}
+
+
+sub 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/=([\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/t/lib/mimeb64.t b/t/lib/mimeb64.t
new file mode 100644 (file)
index 0000000..5bb78b1
--- /dev/null
@@ -0,0 +1,368 @@
+BEGIN {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+}
+
+use MIME::Base64;
+
+print "1..282\n";
+
+print "# Testing MIME::Base64-", $MIME::Base64::VERSION, "\n";
+
+$testno = 1;
+
+encodeTest();
+decodeTest();
+
+# This used to generate a warning
+print "not " unless decode_base64(encode_base64("foo")) eq "foo";
+print "ok ", $testno++, "\n";
+
+sub encodeTest
+{
+    print "# encode test\n";
+
+    my @encode_tests = (
+        [''    => ''],
+       ['a'   => 'YQ=='],
+       ['aa'  => 'YWE='],
+       ['aaa' => 'YWFh'],
+
+       ['aaa' => 'YWFh'],
+       ['aaa' => 'YWFh'],
+       ['aaa' => 'YWFh'],
+
+       ["\000\377" => "AP8="],
+       ["\377\000" => "/wA="],
+       ["\000\000\000" => "AAAA"],
+
+       # from HTTP spec
+       ['Aladdin:open sesame' => 'QWxhZGRpbjpvcGVuIHNlc2FtZQ=='],
+
+       ['a' x 100 => 'YWFh' x 33 . 'YQ=='],
+
+       ['Multipurpose Internet Mail Extensions: The Base64 Content-Transfer-Encoding is designed to represent sequences of octets in a form that is not humanly readable. '
+       => "TXVsdGlwdXJwb3NlIEludGVybmV0IE1haWwgRXh0ZW5zaW9uczogVGhlIEJhc2U2NCBDb250ZW50LVRyYW5zZmVyLUVuY29kaW5nIGlzIGRlc2lnbmVkIHRvIHJlcHJlc2VudCBzZXF1ZW5jZXMgb2Ygb2N0ZXRzIGluIGEgZm9ybSB0aGF0IGlzIG5vdCBodW1hbmx5IHJlYWRhYmxlLiA="],
+
+       # All values
+       ["\000" => "AA=="],
+       ["\001" => "AQ=="],
+       ["\002" => "Ag=="],
+       ["\003" => "Aw=="],
+       ["\004" => "BA=="],
+       ["\005" => "BQ=="],
+       ["\006" => "Bg=="],
+       ["\007" => "Bw=="],
+       ["\010" => "CA=="],
+       ["\011" => "CQ=="],
+       ["\012" => "Cg=="],
+       ["\013" => "Cw=="],
+       ["\014" => "DA=="],
+       ["\015" => "DQ=="],
+       ["\016" => "Dg=="],
+       ["\017" => "Dw=="],
+       ["\020" => "EA=="],
+       ["\021" => "EQ=="],
+       ["\022" => "Eg=="],
+       ["\023" => "Ew=="],
+       ["\024" => "FA=="],
+       ["\025" => "FQ=="],
+       ["\026" => "Fg=="],
+       ["\027" => "Fw=="],
+       ["\030" => "GA=="],
+       ["\031" => "GQ=="],
+       ["\032" => "Gg=="],
+       ["\033" => "Gw=="],
+       ["\034" => "HA=="],
+       ["\035" => "HQ=="],
+       ["\036" => "Hg=="],
+       ["\037" => "Hw=="],
+       ["\040" => "IA=="],
+       ["\041" => "IQ=="],
+       ["\042" => "Ig=="],
+       ["\043" => "Iw=="],
+       ["\044" => "JA=="],
+       ["\045" => "JQ=="],
+       ["\046" => "Jg=="],
+       ["\047" => "Jw=="],
+       ["\050" => "KA=="],
+       ["\051" => "KQ=="],
+       ["\052" => "Kg=="],
+       ["\053" => "Kw=="],
+       ["\054" => "LA=="],
+       ["\055" => "LQ=="],
+       ["\056" => "Lg=="],
+       ["\057" => "Lw=="],
+       ["\060" => "MA=="],
+       ["\061" => "MQ=="],
+       ["\062" => "Mg=="],
+       ["\063" => "Mw=="],
+       ["\064" => "NA=="],
+       ["\065" => "NQ=="],
+       ["\066" => "Ng=="],
+       ["\067" => "Nw=="],
+       ["\070" => "OA=="],
+       ["\071" => "OQ=="],
+       ["\072" => "Og=="],
+       ["\073" => "Ow=="],
+       ["\074" => "PA=="],
+       ["\075" => "PQ=="],
+       ["\076" => "Pg=="],
+       ["\077" => "Pw=="],
+       ["\100" => "QA=="],
+       ["\101" => "QQ=="],
+       ["\102" => "Qg=="],
+       ["\103" => "Qw=="],
+       ["\104" => "RA=="],
+       ["\105" => "RQ=="],
+       ["\106" => "Rg=="],
+       ["\107" => "Rw=="],
+       ["\110" => "SA=="],
+       ["\111" => "SQ=="],
+       ["\112" => "Sg=="],
+       ["\113" => "Sw=="],
+       ["\114" => "TA=="],
+       ["\115" => "TQ=="],
+       ["\116" => "Tg=="],
+       ["\117" => "Tw=="],
+       ["\120" => "UA=="],
+       ["\121" => "UQ=="],
+       ["\122" => "Ug=="],
+       ["\123" => "Uw=="],
+       ["\124" => "VA=="],
+       ["\125" => "VQ=="],
+       ["\126" => "Vg=="],
+       ["\127" => "Vw=="],
+       ["\130" => "WA=="],
+       ["\131" => "WQ=="],
+       ["\132" => "Wg=="],
+       ["\133" => "Ww=="],
+       ["\134" => "XA=="],
+       ["\135" => "XQ=="],
+       ["\136" => "Xg=="],
+       ["\137" => "Xw=="],
+       ["\140" => "YA=="],
+       ["\141" => "YQ=="],
+       ["\142" => "Yg=="],
+       ["\143" => "Yw=="],
+       ["\144" => "ZA=="],
+       ["\145" => "ZQ=="],
+       ["\146" => "Zg=="],
+       ["\147" => "Zw=="],
+       ["\150" => "aA=="],
+       ["\151" => "aQ=="],
+       ["\152" => "ag=="],
+       ["\153" => "aw=="],
+       ["\154" => "bA=="],
+       ["\155" => "bQ=="],
+       ["\156" => "bg=="],
+       ["\157" => "bw=="],
+       ["\160" => "cA=="],
+       ["\161" => "cQ=="],
+       ["\162" => "cg=="],
+       ["\163" => "cw=="],
+       ["\164" => "dA=="],
+       ["\165" => "dQ=="],
+       ["\166" => "dg=="],
+       ["\167" => "dw=="],
+       ["\170" => "eA=="],
+       ["\171" => "eQ=="],
+       ["\172" => "eg=="],
+       ["\173" => "ew=="],
+       ["\174" => "fA=="],
+       ["\175" => "fQ=="],
+       ["\176" => "fg=="],
+       ["\177" => "fw=="],
+       ["\200" => "gA=="],
+       ["\201" => "gQ=="],
+       ["\202" => "gg=="],
+       ["\203" => "gw=="],
+       ["\204" => "hA=="],
+       ["\205" => "hQ=="],
+       ["\206" => "hg=="],
+       ["\207" => "hw=="],
+       ["\210" => "iA=="],
+       ["\211" => "iQ=="],
+       ["\212" => "ig=="],
+       ["\213" => "iw=="],
+       ["\214" => "jA=="],
+       ["\215" => "jQ=="],
+       ["\216" => "jg=="],
+       ["\217" => "jw=="],
+       ["\220" => "kA=="],
+       ["\221" => "kQ=="],
+       ["\222" => "kg=="],
+       ["\223" => "kw=="],
+       ["\224" => "lA=="],
+       ["\225" => "lQ=="],
+       ["\226" => "lg=="],
+       ["\227" => "lw=="],
+       ["\230" => "mA=="],
+       ["\231" => "mQ=="],
+       ["\232" => "mg=="],
+       ["\233" => "mw=="],
+       ["\234" => "nA=="],
+       ["\235" => "nQ=="],
+       ["\236" => "ng=="],
+       ["\237" => "nw=="],
+       ["\240" => "oA=="],
+       ["\241" => "oQ=="],
+       ["\242" => "og=="],
+       ["\243" => "ow=="],
+       ["\244" => "pA=="],
+       ["\245" => "pQ=="],
+       ["\246" => "pg=="],
+       ["\247" => "pw=="],
+       ["\250" => "qA=="],
+       ["\251" => "qQ=="],
+       ["\252" => "qg=="],
+       ["\253" => "qw=="],
+       ["\254" => "rA=="],
+       ["\255" => "rQ=="],
+       ["\256" => "rg=="],
+       ["\257" => "rw=="],
+       ["\260" => "sA=="],
+       ["\261" => "sQ=="],
+       ["\262" => "sg=="],
+       ["\263" => "sw=="],
+       ["\264" => "tA=="],
+       ["\265" => "tQ=="],
+       ["\266" => "tg=="],
+       ["\267" => "tw=="],
+       ["\270" => "uA=="],
+       ["\271" => "uQ=="],
+       ["\272" => "ug=="],
+       ["\273" => "uw=="],
+       ["\274" => "vA=="],
+       ["\275" => "vQ=="],
+       ["\276" => "vg=="],
+       ["\277" => "vw=="],
+       ["\300" => "wA=="],
+       ["\301" => "wQ=="],
+       ["\302" => "wg=="],
+       ["\303" => "ww=="],
+       ["\304" => "xA=="],
+       ["\305" => "xQ=="],
+       ["\306" => "xg=="],
+       ["\307" => "xw=="],
+       ["\310" => "yA=="],
+       ["\311" => "yQ=="],
+       ["\312" => "yg=="],
+       ["\313" => "yw=="],
+       ["\314" => "zA=="],
+       ["\315" => "zQ=="],
+       ["\316" => "zg=="],
+       ["\317" => "zw=="],
+       ["\320" => "0A=="],
+       ["\321" => "0Q=="],
+       ["\322" => "0g=="],
+       ["\323" => "0w=="],
+       ["\324" => "1A=="],
+       ["\325" => "1Q=="],
+       ["\326" => "1g=="],
+       ["\327" => "1w=="],
+       ["\330" => "2A=="],
+       ["\331" => "2Q=="],
+       ["\332" => "2g=="],
+       ["\333" => "2w=="],
+       ["\334" => "3A=="],
+       ["\335" => "3Q=="],
+       ["\336" => "3g=="],
+       ["\337" => "3w=="],
+       ["\340" => "4A=="],
+       ["\341" => "4Q=="],
+       ["\342" => "4g=="],
+       ["\343" => "4w=="],
+       ["\344" => "5A=="],
+       ["\345" => "5Q=="],
+       ["\346" => "5g=="],
+       ["\347" => "5w=="],
+       ["\350" => "6A=="],
+       ["\351" => "6Q=="],
+       ["\352" => "6g=="],
+       ["\353" => "6w=="],
+       ["\354" => "7A=="],
+       ["\355" => "7Q=="],
+       ["\356" => "7g=="],
+       ["\357" => "7w=="],
+       ["\360" => "8A=="],
+       ["\361" => "8Q=="],
+       ["\362" => "8g=="],
+       ["\363" => "8w=="],
+       ["\364" => "9A=="],
+       ["\365" => "9Q=="],
+       ["\366" => "9g=="],
+       ["\367" => "9w=="],
+       ["\370" => "+A=="],
+       ["\371" => "+Q=="],
+       ["\372" => "+g=="],
+       ["\373" => "+w=="],
+       ["\374" => "/A=="],
+       ["\375" => "/Q=="],
+       ["\376" => "/g=="],
+       ["\377" => "/w=="],
+    );
+
+    for $test (@encode_tests) {
+       my($plain, $expected) = ($$test[0], $$test[1]);
+
+       my $encoded = encode_base64($plain, '');
+       if ($encoded ne $expected) {
+           print "test $testno ($plain): expected $expected, got $encoded\n";
+            print "not ";
+       }
+       my $decoded = decode_base64($encoded);
+       if ($decoded ne $plain) {
+           print "test $testno ($plain): expected $expected, got $encoded\n";
+            print "not ";
+       }
+
+       # Try the old C 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++;
+    }
+}
+
+sub decodeTest
+{
+    print "# decode test\n";
+
+    local $SIG{__WARN__} = sub { print $_[0] };  # avoid warnings on stderr
+
+    my @decode_tests = (
+       ['YWE='   => 'aa'],
+       [' YWE='  => 'aa'],
+       ['Y WE='  => 'aa'],
+       ['YWE= '  => 'aa'],
+       ["Y\nW\r\nE=" => 'aa'],
+
+       # These will generate some warnings
+        ['YWE=====' => 'aa'],    # extra padding
+       ['YWE'      => 'aa'],    # missing padding
+        ['YWFh====' => 'aaa'],
+        ['YQ'       => 'a'],
+        ['Y'        => ''],
+        [''         => ''],
+        [undef()    => ''],
+    );
+
+    for $test (@decode_tests) {
+       my($encoded, $expected) = ($$test[0], $$test[1]);
+
+       my $decoded = decode_base64($encoded);
+       if ($decoded ne $expected) {
+           die "test $testno ($encoded): expected $expected, got $decoded\n";
+       }
+       print "ok $testno\n";
+       $testno++;
+    }
+}
diff --git a/t/lib/mimeb64u.t b/t/lib/mimeb64u.t
new file mode 100644 (file)
index 0000000..0b8df1a
--- /dev/null
@@ -0,0 +1,16 @@
+BEGIN {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+}
+
+print "1..1\n";
+
+require MIME::Base64;
+
+eval {
+    MIME::Base64::encode(v300);
+};
+
+print "not " unless $@;
+print "ok 1\n";
+
diff --git a/t/lib/mimeqp.t b/t/lib/mimeqp.t
new file mode 100644 (file)
index 0000000..b3a740a
--- /dev/null
@@ -0,0 +1,109 @@
+BEGIN {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+}
+
+use MIME::QuotedPrint;
+
+$x70 = "x" x 70;
+
+@tests =
+  (
+   # plain ascii should not be encoded
+   ["quoted printable"  =>
+    "quoted printable"],
+
+   # 8-bit chars should be encoded
+   ["våre kjære norske tegn bør æres" =>
+    "v=E5re kj=E6re norske tegn b=F8r =E6res"],
+
+   # trailing space should be encoded
+   ["  " => "=20=20"],
+   ["\tt\t" => "\tt=09"],
+   ["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"],
+
+   # 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." =>
+    "The Quoted-Printable encoding is intended to represent data that largly con=
+sists of octets that correspond to printable characters in the ASCII charac=
+ter set."
+    ],
+
+   # Long lines after short lines were broken through 2.01.
+   ["short line
+In America, any boy may become president and I suppose that's just one of the risks he takes. -- Adlai Stevenson" =>
+    "short line
+In America, any boy may become president and I suppose that's just one of t=
+he risks he takes. -- Adlai Stevenson"],
+
+   # My (roderick@argon.org) first crack at fixing that bug failed for
+   # multiple long lines.
+   ["College football is a game which would be much more interesting if the faculty played instead of the students, and even more interesting if the
+trustees played.  There would be a great increase in broken arms, legs, and necks, and simultaneously an appreciable diminution in the loss to humanity. -- H. L. Mencken" =>
+    "College football is a game which would be much more interesting if the facu=
+lty played instead of the students, and even more interesting if the
+trustees played.  There would be a great increase in broken arms, legs, and=
+ necks, and simultaneously an appreciable diminution in the loss to humanit=
+y. -- H. L. Mencken"],
+
+   # Don't break a line that's near but not over 76 chars.
+   ["$x70!23"          => "$x70!23"],
+   ["$x70!234"         => "$x70!234"],
+   ["$x70!2345"                => "$x70!2345"],
+   ["$x70!23456"       => "$x70!23456"],
+   ["$x70!23\n"                => "$x70!23\n"],
+   ["$x70!234\n"       => "$x70!234\n"],
+   ["$x70!2345\n"      => "$x70!2345\n"],
+   ["$x70!23456\n"     => "$x70!23456\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
+);
+
+$notests = @tests + 2;
+print "1..$notests\n";
+
+$testno = 0;
+for (@tests) {
+    $testno++;
+    ($plain, $encoded) = @$_;
+    $x = encode_qp($plain);
+    if ($x ne $encoded) {
+       print "Encode test failed\n";
+       print "Got:      '$x'\n";
+       print "Expected: '$encoded'\n";
+       print "not ok $testno\n";
+       next;
+    }
+    $x = decode_qp($encoded);
+    if ($x ne $plain) {
+       print "Decode test failed\n";
+       print "Got:      '$x'\n";
+       print "Expected: '$plain'\n";
+       print "not ok $testno\n";
+       next;
+    }
+    print "ok $testno\n";
+}
+
+# Some extra testing for a case that was wrong until libwww-perl-5.09
+print "not " unless decode_qp("foo  \n\nfoo =\n\nfoo=20\n\n") eq
+                                "foo\n\nfoo \nfoo \n\n";
+$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";
+$testno++; print "ok $testno\n";
+