ext/MIME/Base64/Changes MIME::Base64 extension
ext/MIME/Base64/Makefile.PL MIME::Base64 extension
ext/MIME/Base64/QuotedPrint.pm MIME::Base64 extension
+ext/MIME/Base64/encode-qp MIME::Base64 utility
+ext/MIME/Base64/decode-qp MIME::Base64 utility
+ext/MIME/Base64/encode-base64 MIME::Base64 utility
+ext/MIME/Base64/decode-base64 MIME::Base64 utility
ext/MIME/Base64/t/base64.t See whether MIME::Base64 works
ext/MIME/Base64/t/quoted-print.t See whether MIME::QuotedPrint works
ext/MIME/Base64/t/unicode.t See whether MIME::Base64 works
#
-# $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;
=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
=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.
@ISA = qw(Exporter DynaLoader);
@EXPORT = qw(encode_base64 decode_base64);
-$VERSION = '2.13';
+$VERSION = '2.16';
eval { bootstrap MIME::Base64 $VERSION; };
if ($@) {
}
$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) . $_,
-/*
+/* $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.
}
#endif
+#include "patchlevel.h"
+#if PATCHLEVEL <= 4 && !defined(PL_dowarn)
+ #define PL_dowarn dowarn
+#endif
#define MAX_LINE 76 /* size of encoded lines */
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
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;
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
-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
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', },
);
#
-# $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;
=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
=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.
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) {
}
}
+ 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
# 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
}
-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;
--- /dev/null
+#!/usr/bin/perl
+
+use MIME::Base64 qw(decode_base64);
+
+while (<>) {
+ print decode_base64($_);
+}
+
--- /dev/null
+#!/usr/bin/perl
+
+use MIME::QuotedPrint qw(decode_qp);
+
+while (<>) {
+ print decode_qp($_);
+}
+
--- /dev/null
+#!/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);
--- /dev/null
+#!/usr/bin/perl
+
+use MIME::QuotedPrint qw(encode_qp);
+
+while (<>) {
+ print encode_qp($_);
+}
+
}
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";
["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." =>
["$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;
# 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";
projects / p5sagit/p5-mst-13.2.git / commitdiff