1 | #
|
---|
2 | # $Id: QuotedPrint.pm 718 1999-10-19 02:36:47Z davidb $
|
---|
3 |
|
---|
4 | package MIME::QuotedPrint;
|
---|
5 |
|
---|
6 | =head1 NAME
|
---|
7 |
|
---|
8 | MIME::QuotedPrint - Encoding and decoding of quoted-printable strings
|
---|
9 |
|
---|
10 | =head1 SYNOPSIS
|
---|
11 |
|
---|
12 | use MIME::QuotedPrint;
|
---|
13 |
|
---|
14 | $encoded = encode_qp($decoded);
|
---|
15 | $decoded = decode_qp($encoded);
|
---|
16 |
|
---|
17 | =head1 DESCRIPTION
|
---|
18 |
|
---|
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
|
---|
26 | digits.
|
---|
27 |
|
---|
28 | The following functions are provided:
|
---|
29 |
|
---|
30 | =over 4
|
---|
31 |
|
---|
32 | =item encode_qp($str)
|
---|
33 |
|
---|
34 | This function will return an encoded version of the string given as
|
---|
35 | argument.
|
---|
36 |
|
---|
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)).
|
---|
40 |
|
---|
41 | =item decode_qp($str);
|
---|
42 |
|
---|
43 | This function will return the plain text version of the string given
|
---|
44 | as argument.
|
---|
45 |
|
---|
46 | =back
|
---|
47 |
|
---|
48 |
|
---|
49 | If you prefer not to import these routines into your namespace you can
|
---|
50 | call them as:
|
---|
51 |
|
---|
52 | use MIME::QuotedPrint ();
|
---|
53 | $encoded = MIME::QuotedPrint::encode($decoded);
|
---|
54 | $decoded = MIME::QuotedPrint::decode($encoded);
|
---|
55 |
|
---|
56 | =head1 COPYRIGHT
|
---|
57 |
|
---|
58 | Copyright 1995-1997 Gisle Aas.
|
---|
59 |
|
---|
60 | This library is free software; you can redistribute it and/or
|
---|
61 | modify it under the same terms as Perl itself.
|
---|
62 |
|
---|
63 | =cut
|
---|
64 |
|
---|
65 | use strict;
|
---|
66 | use vars qw(@ISA @EXPORT $VERSION);
|
---|
67 |
|
---|
68 | require Exporter;
|
---|
69 | @ISA = qw(Exporter);
|
---|
70 | @EXPORT = qw(encode_qp decode_qp);
|
---|
71 |
|
---|
72 | $VERSION = sprintf("%d.%02d", q$Revision: 718 $ =~ /(\d+)\.(\d+)/);
|
---|
73 |
|
---|
74 |
|
---|
75 | sub encode_qp ($)
|
---|
76 | {
|
---|
77 | my $res = shift;
|
---|
78 | $res =~ s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg; # rule #2,#3
|
---|
79 | $res =~ s/([ \t]+)$/
|
---|
80 | join('', map { sprintf("=%02X", ord($_)) }
|
---|
81 | split('', $1)
|
---|
82 | )/egm; # rule #3 (encode whitespace at eol)
|
---|
83 |
|
---|
84 | # rule #5 (lines must be shorter than 76 chars, but we are not allowed
|
---|
85 | # to break =XX escapes. This makes things complicated :-( )
|
---|
86 | my $brokenlines = "";
|
---|
87 | $brokenlines .= "$1=\n"
|
---|
88 | while $res =~ s/(.*?^[^\n]{73} (?:
|
---|
89 | [^=\n]{2} (?! [^=\n]{0,1} $) # 75 not followed by .?\n
|
---|
90 | |[^=\n] (?! [^=\n]{0,2} $) # 74 not followed by .?.?\n
|
---|
91 | | (?! [^=\n]{0,3} $) # 73 not followed by .?.?.?\n
|
---|
92 | ))//xsm;
|
---|
93 |
|
---|
94 | "$brokenlines$res";
|
---|
95 | }
|
---|
96 |
|
---|
97 |
|
---|
98 | sub decode_qp ($)
|
---|
99 | {
|
---|
100 | my $res = shift;
|
---|
101 | $res =~ s/[ \t]+?(\r?\n)/$1/g; # rule #3 (trailing space must be deleted)
|
---|
102 | $res =~ s/=\r?\n//g; # rule #5 (soft line breaks)
|
---|
103 | $res =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge;
|
---|
104 | $res;
|
---|
105 | }
|
---|
106 |
|
---|
107 | # Set up aliases so that these functions also can be called as
|
---|
108 | #
|
---|
109 | # MIME::QuotedPrint::encode();
|
---|
110 | # MIME::QuotedPrint::decode();
|
---|
111 |
|
---|
112 | *encode = \&encode_qp;
|
---|
113 | *decode = \&decode_qp;
|
---|
114 |
|
---|
115 | 1;
|
---|