2 # $Id: QuotedPrint.pm,v 2.19 2004/01/08 14:07:26 gisle Exp $
4 package MIME::QuotedPrint;
8 MIME::QuotedPrint - Encoding and decoding of quoted-printable strings
12 use MIME::QuotedPrint;
14 $encoded = encode_qp($decoded);
15 $decoded = decode_qp($encoded);
19 This module provides functions to encode and decode strings into and from the
20 quoted-printable encoding specified in RFC 2045 - I<MIME (Multipurpose
21 Internet Mail Extensions)>. The quoted-printable encoding is intended
22 to represent data that largely consists of bytes that correspond to
23 printable characters in the ASCII character set. Each non-printable
24 character (as defined by English Americans) is represented by a
25 triplet consisting of the character "=" followed by two hexadecimal
28 The following functions are provided:
34 =item encode_qp($str, $eol)
36 This function returns an encoded version of the string given as
39 The second argument is the line-ending sequence to use. It is
40 optional and defaults to "\n". Every occurrence of "\n" is
41 replaced with this string, and it is also used for additional
42 "soft line breaks" to ensure that no line is longer than 76
43 characters. You might want to pass it as "\015\012" to produce data
44 suitable for external consumption. The string "\r\n" produces the
45 same result on many platforms, but not all.
47 An $eol of "" (the empty string) is special. In this case, no "soft line breaks" are introduced
48 and any literal "\n" in the original data is encoded as well.
50 =item decode_qp($str);
52 This function returns the plain text version of the string given
53 as argument. The lines of the result are "\n" terminated, even if
54 the $str argument contains "\r\n" terminated lines.
59 If you prefer not to import these routines into your namespace, you can
62 use MIME::QuotedPrint ();
63 $encoded = MIME::QuotedPrint::encode($decoded);
64 $decoded = MIME::QuotedPrint::decode($encoded);
66 Perl v5.6 and better allow extended Unicode characters in strings.
67 Such strings cannot be encoded directly, as the quoted-printable
68 encoding is only defined for single-byte characters. The solution is to use the Encode
69 module to select the byte encoding you want. For example:
71 use MIME::QuotedPrint qw(encode_qp);
72 use Encode qw(encode);
74 $encoded = encode_qp(encode("UTF-8", "\x{FFFF}\n"));
79 Copyright 1995-1997,2002-2004 Gisle Aas.
81 This library is free software; you can redistribute it and/or
82 modify it under the same terms as Perl itself.
91 use vars qw(@ISA @EXPORT $VERSION);
92 if (ord('A') == 193) { # on EBCDIC machines we need translation help
98 @EXPORT = qw(encode_qp decode_qp);
102 use MIME::Base64; # try to load XS version of encode_qp
103 unless (defined &encode_qp) {
104 *encode_qp = \&old_encode_qp;
105 *decode_qp = \&old_decode_qp;
108 sub old_encode_qp ($;$)
113 if (bytes::length($res) > length($res) ||
114 ($] >= 5.008 && $res =~ /[^\0-\xFF]/))
117 Carp::croak("The Quoted-Printable encoding is only defined for bytes");
122 $eol = "\n" unless defined $eol;
124 # Do not mention ranges such as $res =~ s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg;
125 # since that will not even compile on an EBCDIC machine (where ord('!') > ord('<')).
126 if (ord('A') == 193) { # EBCDIC style machine
127 if (ord('[') == 173) {
128 $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
130 join('', map { sprintf("=%02X", ord(Encode::encode('iso-8859-1',Encode::decode('cp1047',$_)))) }
132 )/egm; # rule #3 (encode whitespace at eol)
134 elsif (ord('[') == 187) {
135 $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
137 join('', map { sprintf("=%02X", ord(Encode::encode('iso-8859-1',Encode::decode('posix-bc',$_)))) }
139 )/egm; # rule #3 (encode whitespace at eol)
141 elsif (ord('[') == 186) {
142 $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
144 join('', map { sprintf("=%02X", ord(Encode::encode('iso-8859-1',Encode::decode('cp37',$_)))) }
146 )/egm; # rule #3 (encode whitespace at eol)
149 else { # ASCII style machine
150 $res =~ s/([^ \t\n!"#\$%&'()*+,\-.\/0-9:;<>?\@A-Z[\\\]^_`a-z{|}~])/sprintf("=%02X", ord($1))/eg; # rule #2,#3
151 $res =~ s/\n/=0A/g unless length($eol);
153 join('', map { sprintf("=%02X", ord($_)) }
155 )/egm; # rule #3 (encode whitespace at eol)
158 return $res unless length($eol);
160 # rule #5 (lines must be shorter than 76 chars, but we are not allowed
161 # to break =XX escapes. This makes things complicated :-( )
162 my $brokenlines = "";
163 $brokenlines .= "$1=$eol"
164 while $res =~ s/(.*?^[^\n]{73} (?:
165 [^=\n]{2} (?! [^=\n]{0,1} $) # 75 not followed by .?\n
166 |[^=\n] (?! [^=\n]{0,2} $) # 74 not followed by .?.?\n
167 | (?! [^=\n]{0,3} $) # 73 not followed by .?.?.?\n
169 $res =~ s/\n\z/$eol/;
175 sub old_decode_qp ($)
178 $res =~ s/\r\n/\n/g; # normalize newlines
179 $res =~ s/[ \t]+\n/\n/g; # rule #3 (trailing space must be deleted)
180 $res =~ s/=\n//g; # rule #5 (soft line breaks)
181 if (ord('A') == 193) { # EBCDIC style machine
182 if (ord('[') == 173) {
183 $res =~ s/=([\da-fA-F]{2})/Encode::encode('cp1047',Encode::decode('iso-8859-1',pack("C", hex($1))))/ge;
185 elsif (ord('[') == 187) {
186 $res =~ s/=([\da-fA-F]{2})/Encode::encode('posix-bc',Encode::decode('iso-8859-1',pack("C", hex($1))))/ge;
188 elsif (ord('[') == 186) {
189 $res =~ s/=([\da-fA-F]{2})/Encode::encode('cp37',Encode::decode('iso-8859-1',pack("C", hex($1))))/ge;
192 else { # ASCII style machine
193 $res =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge;
198 # Set up aliases so that these functions also can be called as
200 # MIME::QuotedPrint::encode();
201 # MIME::QuotedPrint::decode();
203 *encode = \&encode_qp;
204 *decode = \&decode_qp;