1use strict;
2use warnings;
3
4BEGIN {
5        if ($ENV{PERL_CORE}) {
6                chdir 't' if -d 't';
7                @INC = '../lib';
8        }
9}
10
11use MIME::QuotedPrint;
12
13my $x70 = "x" x 70;
14
15my $IsASCII  = ord('A') == 65;
16my $IsEBCDIC = ord('A') == 193;
17
18my @tests;
19
20if ($IsASCII) {
21
22@tests =
23  (
24   # plain ascii should not be encoded
25   ["", ""],
26   ["quoted printable"  =>
27    "quoted printable=\n"],
28
29   # 8-bit chars should be encoded
30   ["v\xe5re kj\xe6re norske tegn b\xf8r \xe6res" =>
31    "v=E5re kj=E6re norske tegn b=F8r =E6res=\n"],
32
33   # trailing space should be encoded
34   ["  " => "=20=20=\n"],
35   ["\tt\t" => "\tt=09=\n"],
36   ["test  \ntest\n\t \t \n" => "test=20=20\ntest\n=09=20=09=20\n"],
37
38   # "=" is special an should be decoded
39   ["=30\n" => "=3D30\n"],
40   ["\0\xff0" => "=00=FF0=\n"],
41
42   # Very long lines should be broken (not more than 76 chars
43   ["The Quoted-Printable encoding is intended to represent data that largly consists of octets that correspond to printable characters in the ASCII character set." =>
44    "The Quoted-Printable encoding is intended to represent data that largly con=
45sists of octets that correspond to printable characters in the ASCII charac=
46ter set.=\n"
47    ],
48
49   # Long lines after short lines were broken through 2.01.
50   ["short line
51In America, any boy may become president and I suppose that's just one of the risks he takes. -- Adlai Stevenson" =>
52    "short line
53In America, any boy may become president and I suppose that's just one of t=
54he risks he takes. -- Adlai Stevenson=\n"],
55
56   # My (roderick@argon.org) first crack at fixing that bug failed for
57   # multiple long lines.
58   ["College football is a game which would be much more interesting if the faculty played instead of the students, and even more interesting if the
59trustees played.  There would be a great increase in broken arms, legs, and necks, and simultaneously an appreciable diminution in the loss to humanity. -- H. L. Mencken" =>
60    "College football is a game which would be much more interesting if the facu=
61lty played instead of the students, and even more interesting if the
62trustees played.  There would be a great increase in broken arms, legs, and=
63 necks, and simultaneously an appreciable diminution in the loss to humanit=
64y. -- H. L. Mencken=\n"],
65
66   # Don't break a line that's near but not over 76 chars.
67   ["$x70!23"		=> "$x70!23=\n"],
68   ["$x70!234"		=> "$x70!234=\n"],
69   ["$x70!2345"		=> "$x70!2345=\n"],
70   ["$x70!23456"	=> "$x70!2345=\n6=\n"],
71   ["$x70!234567"	=> "$x70!2345=\n67=\n"],
72   ["$x70!23456="	=> "$x70!2345=\n6=3D=\n"],
73   ["$x70!23\n"		=> "$x70!23\n"],
74   ["$x70!234\n"	=> "$x70!234\n"],
75   ["$x70!2345\n"	=> "$x70!2345\n"],
76   ["$x70!23456\n"	=> "$x70!23456\n"],
77   ["$x70!234567\n"	=> "$x70!2345=\n67\n"],
78   ["$x70!23456=\n"	=> "$x70!2345=\n6=3D\n"],
79
80   # Not allowed to break =XX escapes using soft line break
81   ["$x70===xxxxx"  => "$x70=3D=\n=3D=3Dxxxxx=\n"],
82   ["$x70!===xxxx"  => "$x70!=3D=\n=3D=3Dxxxx=\n"],
83   ["$x70!2===xxx"  => "$x70!2=3D=\n=3D=3Dxxx=\n"],
84   ["$x70!23===xx"  => "$x70!23=\n=3D=3D=3Dxx=\n"],
85   ["$x70!234===x"  => "$x70!234=\n=3D=3D=3Dx=\n"],
86   ["$x70!2="       => "$x70!2=3D=\n"],
87   ["$x70!23="      => "$x70!23=\n=3D=\n"],
88   ["$x70!234="     => "$x70!234=\n=3D=\n"],
89   ["$x70!2345="    => "$x70!2345=\n=3D=\n"],
90   ["$x70!23456="   => "$x70!2345=\n6=3D=\n"],
91   ["$x70!2=\n"     => "$x70!2=3D\n"],
92   ["$x70!23=\n"    => "$x70!23=3D\n"],
93   ["$x70!234=\n"   => "$x70!234=\n=3D\n"],
94   ["$x70!2345=\n"  => "$x70!2345=\n=3D\n"],
95   ["$x70!23456=\n" => "$x70!2345=\n6=3D\n"],
96   #                              ^
97   #                      70123456|
98   #                             max
99   #                          line width
100
101   # some extra special cases we have had problems with
102   ["$x70!2=x=x" => "$x70!2=3D=\nx=3Dx=\n"],
103   ["$x70!2345$x70!2345$x70!23456\n", "$x70!2345=\n$x70!2345=\n$x70!23456\n"],
104
105   # trailing whitespace
106   ["foo \t ", "foo=20=09=20=\n"],
107   ["foo\t \n \t", "foo=09=20\n=20=09=\n"],
108);
109
110} elsif ($IsEBCDIC) {
111
112@tests =
113  (
114   # plain ascii should not be encoded
115   ["", ""],
116   ["quoted printable"  =>
117    "quoted printable=\n"],
118
119   # 8-bit chars should be encoded
120   ["v\x47re kj\x9cre norske tegn b\x70r \x47res" =>
121    "v=47re kj=9Cre norske tegn b=70r =47res=\n"],
122
123   # trailing space should be encoded
124   ["  " => "=40=40=\n"],
125   ["\tt\t" => "\tt=05=\n"],
126   ["test  \ntest\n\t \t \n" => "test=40=40\ntest\n=05=40=05=40\n"],
127
128   # "=" is special an should be decoded
129   ["=30\n" => "=7E30\n"],
130   ["\0\xff0" => "=00=FF0=\n"],
131
132   # Very long lines should be broken (not more than 76 chars
133   ["The Quoted-Printable encoding is intended to represent data that largly consists of octets that correspond to printable characters in the ASCII character set." =>
134    "The Quoted-Printable encoding is intended to represent data that largly con=
135sists of octets that correspond to printable characters in the ASCII charac=
136ter set.=\n"
137    ],
138
139   # Long lines after short lines were broken through 2.01.
140   ["short line
141In America, any boy may become president and I suppose that's just one of the risks he takes. -- Adlai Stevenson" =>
142    "short line
143In America, any boy may become president and I suppose that's just one of t=
144he risks he takes. -- Adlai Stevenson=\n"],
145
146   # My (roderick@argon.org) first crack at fixing that bug failed for
147   # multiple long lines.
148   ["College football is a game which would be much more interesting if the faculty played instead of the students, and even more interesting if the
149trustees played.  There would be a great increase in broken arms, legs, and necks, and simultaneously an appreciable diminution in the loss to humanity. -- H. L. Mencken" =>
150    "College football is a game which would be much more interesting if the facu=
151lty played instead of the students, and even more interesting if the
152trustees played.  There would be a great increase in broken arms, legs, and=
153 necks, and simultaneously an appreciable diminution in the loss to humanit=
154y. -- H. L. Mencken=\n"],
155
156   # Don't break a line that's near but not over 76 chars.
157   ["$x70!23"		=> "$x70!23=\n"],
158   ["$x70!234"		=> "$x70!234=\n"],
159   ["$x70!2345"		=> "$x70!2345=\n"],
160   ["$x70!23456"	=> "$x70!2345=\n6=\n"],
161   ["$x70!234567"	=> "$x70!2345=\n67=\n"],
162   ["$x70!23456="	=> "$x70!2345=\n6=7E=\n"],
163   ["$x70!23\n"		=> "$x70!23\n"],
164   ["$x70!234\n"	=> "$x70!234\n"],
165   ["$x70!2345\n"	=> "$x70!2345\n"],
166   ["$x70!23456\n"	=> "$x70!23456\n"],
167   ["$x70!234567\n"	=> "$x70!2345=\n67\n"],
168   ["$x70!23456=\n"	=> "$x70!2345=\n6=7E\n"],
169
170   # Not allowed to break =XX escapes using soft line break
171   ["$x70===xxxxx"  => "$x70=7E=\n=7E=7Exxxxx=\n"],
172   ["$x70!===xxxx"  => "$x70!=7E=\n=7E=7Exxxx=\n"],
173   ["$x70!2===xxx"  => "$x70!2=7E=\n=7E=7Exxx=\n"],
174   ["$x70!23===xx"  => "$x70!23=\n=7E=7E=7Exx=\n"],
175   ["$x70!234===x"  => "$x70!234=\n=7E=7E=7Ex=\n"],
176   ["$x70!2=\n"     => "$x70!2=7E\n"],
177   ["$x70!23=\n"    => "$x70!23=\n=7E\n"],
178   ["$x70!234=\n"   => "$x70!234=\n=7E\n"],
179   ["$x70!2345=\n"  => "$x70!2345=\n=7E\n"],
180   ["$x70!23456=\n" => "$x70!2345=\n6=7E\n"],
181   #                              ^
182   #                      70123456|
183   #                             max
184   #                          line width
185
186   # some extra special cases we have had problems with
187   ["$x70!2=x=x" => "$x70!2=7E=\nx=7Ex=\n"],
188   ["$x70!2345$x70!2345$x70!23456\n", "$x70!2345=\n$x70!2345=\n$x70!23456\n"],
189
190   # trailing whitespace
191   ["foo \t ", "foo=40=05=40=\n"],
192   ["foo\t \n \t", "foo=05=40\n=40=05=\n"],
193);
194
195} else {
196  die sprintf "Unknown character set: ord('A') == %d\n", ord('A');
197}
198
199my $notests = @tests + 16;
200print "1..$notests\n";
201
202my $testno = 0;
203for (@tests) {
204    $testno++;
205    my ($plain, $encoded) = @$_;
206    if (ord('A') == 193) {  # EBCDIC 8 bit chars are different
207        if ($testno == 2) { $plain =~ s/\xe5/\x47/; $plain =~ s/\xe6/\x9c/g; $plain =~ s/\xf8/\x70/; }
208        if ($testno == 7) { $plain =~ s/\xff/\xdf/; }
209    }
210    my $x = encode_qp($plain);
211    if ($x ne $encoded) {
212	print "Encode test failed\n";
213	print "Got:      '$x'\n";
214	print "Expected: '$encoded'\n";
215	print "not ok $testno\n";
216	next;
217    }
218    $x = decode_qp($encoded);
219    if ($x ne $plain) {
220	print "Decode test failed\n";
221	print "Got:      '$x'\n";
222	print "Expected: '$plain'\n";
223	print "not ok $testno\n";
224	next;
225    }
226    print "ok $testno\n";
227}
228
229if ($IsASCII) {
230
231# Some extra testing for a case that was wrong until libwww-perl-5.09
232print "not " unless decode_qp("foo  \n\nfoo =\n\nfoo=20\n\n") eq
233                                "foo\n\nfoo \nfoo \n\n";
234$testno++; print "ok $testno\n";
235
236# Same test but with "\r\n" terminated lines
237print "not " unless decode_qp("foo  \r\n\r\nfoo =\r\n\r\nfoo=20\r\n\r\n") eq
238                                "foo\n\nfoo \nfoo \n\n";
239$testno++; print "ok $testno\n";
240
241# Trailing whitespace
242print "not " unless decode_qp("foo  ") eq "foo  ";
243$testno++; print "ok $testno\n";
244
245print "not " unless decode_qp("foo  \n") eq "foo\n";
246$testno++; print "ok $testno\n";
247
248print "not " unless decode_qp("foo = \t\x20\nbar\t\x20\n") eq "foo bar\n";
249$testno++; print "ok $testno\n";
250
251print "not " unless decode_qp("foo = \t\x20\r\nbar\t\x20\r\n") eq "foo bar\n";
252$testno++; print "ok $testno\n";
253
254print "not " unless decode_qp("foo = \t\x20\n") eq "foo ";
255$testno++; print "ok $testno\n";
256
257print "not " unless decode_qp("foo = \t\x20\r\n") eq "foo ";
258$testno++; print "ok $testno\n";
259
260print "not " unless decode_qp("foo = \t\x20y\r\n") eq "foo = \t\x20y\n";
261$testno++; print "ok $testno\n";
262
263print "not " unless decode_qp("foo =xy\n") eq "foo =xy\n";
264$testno++; print "ok $testno\n";
265
266# Test with with alternative line break
267print "not " unless encode_qp("$x70!2345$x70\n", "***") eq "$x70!2345=***$x70***";
268$testno++; print "ok $testno\n";
269
270# Test with no line breaks
271print "not " unless encode_qp("$x70!2345$x70\n", "") eq "$x70!2345$x70=0A";
272$testno++; print "ok $testno\n";
273
274# Test binary encoding
275print "not " unless encode_qp("foo", undef, 1) eq "foo=\n";
276$testno++; print "ok $testno\n";
277
278print "not " unless encode_qp("foo\nbar\r\n", undef, 1) eq "foo=0Abar=0D=0A=\n";
279$testno++; print "ok $testno\n";
280
281print "not " unless encode_qp(join("", map chr, 0..255), undef, 1) eq <<'EOT'; $testno++; print "ok $testno\n";
282=00=01=02=03=04=05=06=07=08=09=0A=0B=0C=0D=0E=0F=10=11=12=13=14=15=16=17=18=
283=19=1A=1B=1C=1D=1E=1F !"#$%&'()*+,-./0123456789:;<=3D>?@ABCDEFGHIJKLMNOPQRS=
284TUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~=7F=80=81=82=83=84=85=86=87=88=
285=89=8A=8B=8C=8D=8E=8F=90=91=92=93=94=95=96=97=98=99=9A=9B=9C=9D=9E=9F=A0=A1=
286=A2=A3=A4=A5=A6=A7=A8=A9=AA=AB=AC=AD=AE=AF=B0=B1=B2=B3=B4=B5=B6=B7=B8=B9=BA=
287=BB=BC=BD=BE=BF=C0=C1=C2=C3=C4=C5=C6=C7=C8=C9=CA=CB=CC=CD=CE=CF=D0=D1=D2=D3=
288=D4=D5=D6=D7=D8=D9=DA=DB=DC=DD=DE=DF=E0=E1=E2=E3=E4=E5=E6=E7=E8=E9=EA=EB=EC=
289=ED=EE=EF=F0=F1=F2=F3=F4=F5=F6=F7=F8=F9=FA=FB=FC=FD=FE=FF=
290EOT
291
292print "not " if $] >= 5.006 && (eval 'encode_qp("XXX \x{100}")' || !$@);
293$testno++; print "ok $testno\n";
294
295} elsif ($IsEBCDIC) {
296
297# Some extra testing for a case that was wrong until libwww-perl-5.05
298print "not " unless decode_qp("foo  \n\nfoo =\n\nfoo=40\n\n") eq
299                                "foo\n\nfoo \nfoo \n\n";
300$testno++; print "ok $testno\n";
301
302# Same test but with "\r\n" terminated lines
303print "not " unless decode_qp("foo  \r\n\r\nfoo =\r\n\r\nfoo=40\r\n\r\n") eq
304                                "foo\n\nfoo \nfoo \n\n";
305$testno++; print "ok $testno\n";
306
307# Trailing whitespace
308print "not " unless decode_qp("foo  ") eq "foo  ";
309$testno++; print "ok $testno\n";
310
311print "not " unless decode_qp("foo  \n") eq "foo\n";
312$testno++; print "ok $testno\n";
313
314print "not " unless decode_qp("foo = \t\x40\nbar\t\x40\n") eq "foo bar\n";
315$testno++; print "ok $testno\n";
316
317print "not " unless decode_qp("foo = \t\x40\r\nbar\t\x40\r\n") eq "foo bar\n";
318$testno++; print "ok $testno\n";
319
320print "not " unless decode_qp("foo = \t\x40\n") eq "foo ";
321$testno++; print "ok $testno\n";
322
323print "not " unless decode_qp("foo = \t\x40\r\n") eq "foo ";
324$testno++; print "ok $testno\n";
325
326print "not " unless decode_qp("foo = \t\x40y\r\n") eq "foo = \t\x40y\n";
327$testno++; print "ok $testno\n";
328
329print "not " unless decode_qp("foo =xy\n") eq "foo =xy\n";
330$testno++; print "ok $testno\n";
331
332# Test with with alternative line break
333print "not " unless encode_qp("$x70!2345$x70\n", "***") eq "$x70!2345=***$x70***";
334$testno++; print "ok $testno\n";
335
336# Test with no line breaks
337print "not " unless encode_qp("$x70!2345$x70\n", "") eq "$x70!2345$x70=15";
338$testno++; print "ok $testno\n";
339
340# Test binary encoding
341print "not " unless encode_qp("foo", undef, 1) eq "foo=\n";
342$testno++; print "ok $testno\n";
343
344print "not " unless encode_qp("foo\nbar\r\n", undef, 1) eq "foo=15bar=0D=15=\n";
345$testno++; print "ok $testno\n";
346
347print "not " unless encode_qp(join("", map chr, 0..255), undef, 1) eq <<'EOT'; $testno++; print "ok $testno\n";
348=00=01=02=03=04=05=06=07=08=09=0A=0B=0C=0D=0E=0F=10=11=12=13=14=15=16=17=18=
349=19=1A=1B=1C=1D=1E=1F=20=21=22=23=24=25=26=27=28=29=2A=2B=2C=2D=2E=2F=30=31=
350=32=33=34=35=36=37=38=39=3A=3B=3C=3D=3E=3F =41=42=43=44=45=46=47=48=49=4A.<=
351(+|&=51=52=53=54=55=56=57=58=59!$*);^-/=62=63=64=65=66=67=68=69=6A,%_>?=70=
352=71=72=73=74=75=76=77=78`:#@'=7E"=80abcdefghi=8A=8B=8C=8D=8E=8F=90jklmnopqr=
353=9A=9B=9C=9D=9E=9F=A0~stuvwxyz=AA=AB=AC=AD=AE=AF=B0=B1=B2=B3=B4=B5=B6=B7=B8=
354=B9=BA=BB=BC=BD=BE=BF{ABCDEFGHI=CA=CB=CC=CD=CE=CF}JKLMNOPQR=DA=DB=DC=DD=DE=
355=DF\=E1STUVWXYZ=EA=EB=EC=ED=EE=EF0123456789=FA=FB=FC=FD=FE=FF=
356EOT
357
358print "not " if $] >= 5.006 && (eval 'encode_qp("XXX \x{100}")' || !$@);
359$testno++; print "ok $testno\n";
360
361}
362
363