2 # $Id: QuotedPrint.pm,v 2.3 1997/12/02 10:24:27 aas 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 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. Non-printable
24 characters (as defined by english americans) are represented by a
25 triplet consisting of the character "=" followed by two hexadecimal
28 The following functions are provided:
34 This function will return an encoded version of the string given as
37 Note that encode_qp() does not change newlines C<"\n"> to the CRLF
38 sequence even though this might be considered the right thing to do
39 (RFC 2045 (Q-P Rule #4)).
41 =item decode_qp($str);
43 This function will return the plain text version of the string given
49 If you prefer not to import these routines into your namespace you can
52 use MIME::QuotedPrint ();
53 $encoded = MIME::QuotedPrint::encode($decoded);
54 $decoded = MIME::QuotedPrint::decode($encoded);
58 Copyright 1995-1997 Gisle Aas.
60 This library is free software; you can redistribute it and/or
61 modify it under the same terms as Perl itself.
66 use vars qw(@ISA @EXPORT $VERSION);
67 if (ord('A') == 193) { # on EBCDIC machines we need translation help
73 @EXPORT = qw(encode_qp decode_qp);
77 $VERSION = sprintf("%d.%02d", q$Revision: 2.3 $ =~ /(\d+)\.(\d+)/);
82 croak("The Quoted-Printable encoding is only defined for bytes")
83 if $res =~ /[^\0-\xFF]/;
85 # Do not mention ranges such as $res =~ s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg;
86 # since that will not even compile on an EBCDIC machine (where ord('!') > ord('<')).
87 if (ord('A') == 193) { # EBCDIC style machine
88 if (ord('[') == 173) {
89 $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
91 join('', map { sprintf("=%02X", ord(Encode::encode('iso-8859-1',Encode::decode('cp1047',$_)))) }
93 )/egm; # rule #3 (encode whitespace at eol)
95 elsif (ord('[') == 187) {
96 $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
98 join('', map { sprintf("=%02X", ord(Encode::encode('iso-8859-1',Encode::decode('posix-bc',$_)))) }
100 )/egm; # rule #3 (encode whitespace at eol)
102 elsif (ord('[') == 186) {
103 $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
105 join('', map { sprintf("=%02X", ord(Encode::encode('iso-8859-1',Encode::decode('cp37',$_)))) }
107 )/egm; # rule #3 (encode whitespace at eol)
110 else { # ASCII style machine
111 $res =~ s/([^ \t\n!"#\$%&'()*+,\-.\/0-9:;<>?\@A-Z[\\\]^_`a-z{|}~])/sprintf("=%02X", ord($1))/eg; # rule #2,#3
113 join('', map { sprintf("=%02X", ord($_)) }
115 )/egm; # rule #3 (encode whitespace at eol)
118 # rule #5 (lines must be shorter than 76 chars, but we are not allowed
119 # to break =XX escapes. This makes things complicated :-( )
120 my $brokenlines = "";
121 $brokenlines .= "$1=\n"
122 while $res =~ s/(.*?^[^\n]{73} (?:
123 [^=\n]{2} (?! [^=\n]{0,1} $) # 75 not followed by .?\n
124 |[^=\n] (?! [^=\n]{0,2} $) # 74 not followed by .?.?\n
125 | (?! [^=\n]{0,3} $) # 73 not followed by .?.?.?\n
135 $res =~ s/[ \t]+?(\r?\n)/$1/g; # rule #3 (trailing space must be deleted)
136 $res =~ s/=\r?\n//g; # rule #5 (soft line breaks)
137 if (ord('A') == 193) { # EBCDIC style machine
138 if (ord('[') == 173) {
139 $res =~ s/=([\da-fA-F]{2})/Encode::encode('cp1047',Encode::decode('iso-8859-1',pack("C", hex($1))))/ge;
141 elsif (ord('[') == 187) {
142 $res =~ s/=([\da-fA-F]{2})/Encode::encode('posix-bc',Encode::decode('iso-8859-1',pack("C", hex($1))))/ge;
144 elsif (ord('[') == 186) {
145 $res =~ s/=([\da-fA-F]{2})/Encode::encode('cp37',Encode::decode('iso-8859-1',pack("C", hex($1))))/ge;
148 else { # ASCII style machine
149 $res =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge;
154 # Set up aliases so that these functions also can be called as
156 # MIME::QuotedPrint::encode();
157 # MIME::QuotedPrint::decode();
159 *encode = \&encode_qp;
160 *decode = \&decode_qp;
162 # Methods for use as a PerlIO layer object
166 my ($class,$mode) = @_;
167 # When writing we buffer the data
169 return bless \$write,$class;
176 return (defined $line) ? decode_qp($line) : undef;
181 my ($obj,$buf,$fh) = @_;
182 $$obj .= encode_qp($buf);
189 print $fh $$obj or return -1;