-#
-# $Id: QuotedPrint.pm,v 2.3 1997/12/02 10:24:27 aas Exp $
-
package MIME::QuotedPrint;
+# $Id: QuotedPrint.pm,v 3.7 2005/11/29 20:49:46 gisle Exp $
+
+use strict;
+use vars qw(@ISA @EXPORT $VERSION);
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(encode_qp decode_qp);
+
+$VERSION = "3.07";
+
+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
=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
+This module provides functions to encode and decode strings into and from 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
+printable characters in the ASCII character set. Each non-printable
+character (as defined by English Americans) is represented by a
triplet consisting of the character "=" followed by two hexadecimal
digits.
=item encode_qp($str)
-This function will return an encoded version of the string given as
+=item encode_qp($str, $eol)
+
+=item encode_qp($str, $eol, $binmode)
+
+This function returns an encoded version of the string ($str) 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)).
+The second argument ($eol) is the line-ending sequence to use. It is
+optional and defaults to "\n". Every occurrence of "\n" is replaced
+with this string, and it is also used for additional "soft line
+breaks" to ensure that no line end up longer than 76 characters. Pass
+it as "\015\012" to produce data suitable for external consumption.
+The string "\r\n" produces the same result on many platforms, but not
+all.
+
+The third argument ($binmode) will select binary mode if passed as a
+TRUE value. In binary mode "\n" will be encoded in the same way as
+any other non-printable character. This ensures that a decoder will
+end up with exactly the same string whatever line ending sequence it
+uses. In general it is preferable to use the base64 encoding for
+binary data; see L<MIME::Base64>.
+
+An $eol of "" (the empty string) is special. In this case, no "soft
+line breaks" are introduced and binary mode is effectively enabled so
+that any "\n" in the original data is encoded as well.
=item decode_qp($str);
-This function will return the plain text version of the string given
-as argument.
+This function returns the plain text version of the string given
+as argument. The lines of the result are "\n" terminated, even if
+the $str argument contains "\r\n" terminated lines.
=back
-If you prefer not to import these routines into your namespace you can
+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
+Perl v5.8 and better allow extended Unicode characters in strings.
+Such strings cannot be encoded directly, as the quoted-printable
+encoding is only defined for single-byte characters. The solution is
+to use the Encode module to select the byte encoding you want. For
+example:
-Copyright 1995-1997 Gisle Aas.
+ use MIME::QuotedPrint qw(encode_qp);
+ use Encode qw(encode);
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
+ $encoded = encode_qp(encode("UTF-8", "\x{FFFF}\n"));
+ print $encoded;
-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);
+=head1 COPYRIGHT
-$VERSION = sprintf("%d.%02d", q$Revision: 2.3 $ =~ /(\d+)\.(\d+)/);
-
-sub encode_qp ($)
-{
- my $res = shift;
- # 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/([ \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)
- 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();
+Copyright 1995-1997,2002-2004 Gisle Aas.
-*encode = \&encode_qp;
-*decode = \&decode_qp;
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
-# Methods for use as a PerlIO layer object
-
-sub PUSHED
-{
- my ($class,$mode) = @_;
- # When writing we buffer the data
- my $write = '';
- return bless \$write,$class;
-}
-
-sub FILL
-{
- my ($obj,$fh) = @_;
- my $line = <$fh>;
- return (defined $line) ? decode_qp($line) : undef;
- return undef;
-}
-
-sub WRITE
-{
- my ($obj,$buf,$fh) = @_;
- $$obj .= encode_qp($buf);
- return length($buf);
-}
-
-sub FLUSH
-{
- my ($obj,$fh) = @_;
- print $fh $$obj or return -1;
- $$obj = '';
- return 0;
-}
+=head1 SEE ALSO
+L<MIME::Base64>
-1;
+=cut
projects / p5sagit/p5-mst-13.2.git / blobdiff