1BEGIN {
2        if ($ENV{PERL_CORE}) {
3                chdir 't' if -d 't';
4                @INC = '../lib';
5        }
6}
7
8use MIME::QuotedPrint;
9
10$x70 = "x" x 70;
11
12@tests =
13  (
14   # plain ascii should not be encoded
15   ["quoted printable"  =>
16    "quoted printable"],
17
18   # 8-bit chars should be encoded
19   ["v\xe5re kj\xe6re norske tegn b\xf8r \xe6res" =>
20    "v=E5re kj=E6re norske tegn b=F8r =E6res"],
21
22   # trailing space should be encoded
23   ["  " => "=20=20"],
24   ["\tt\t" => "\tt=09"],
25   ["test  \ntest\n\t \t \n" => "test=20=20\ntest\n=09=20=09=20\n"],
26
27   # "=" is special an should be decoded
28   ["=30\n" => "=3D30\n"],
29   ["\0\xff0" => "=00=FF0"],
30
31   # Very long lines should be broken (not more than 76 chars
32   ["The Quoted-Printable encoding is intended to represent data that largly consists of octets that correspond to printable characters in the ASCII character set." =>
33    "The Quoted-Printable encoding is intended to represent data that largly con=
34sists of octets that correspond to printable characters in the ASCII charac=
35ter set."
36    ],
37
38   # Long lines after short lines were broken through 2.01.
39   ["short line
40In America, any boy may become president and I suppose that's just one of the risks he takes. -- Adlai Stevenson" =>
41    "short line
42In America, any boy may become president and I suppose that's just one of t=
43he risks he takes. -- Adlai Stevenson"],
44
45   # My (roderick@argon.org) first crack at fixing that bug failed for
46   # multiple long lines.
47   ["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
48trustees 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" =>
49    "College football is a game which would be much more interesting if the facu=
50lty played instead of the students, and even more interesting if the
51trustees played.  There would be a great increase in broken arms, legs, and=
52 necks, and simultaneously an appreciable diminution in the loss to humanit=
53y. -- H. L. Mencken"],
54
55   # Don't break a line that's near but not over 76 chars.
56   ["$x70!23"		=> "$x70!23"],
57   ["$x70!234"		=> "$x70!234"],
58   ["$x70!2345"		=> "$x70!2345"],
59   ["$x70!23456"	=> "$x70!23456"],
60   ["$x70!234567"	=> "$x70!2345=\n67"],
61   ["$x70!23456="	=> "$x70!2345=\n6=3D"],
62   ["$x70!23\n"		=> "$x70!23\n"],
63   ["$x70!234\n"	=> "$x70!234\n"],
64   ["$x70!2345\n"	=> "$x70!2345\n"],
65   ["$x70!23456\n"	=> "$x70!23456\n"],
66   ["$x70!234567\n"	=> "$x70!2345=\n67\n"],
67   ["$x70!23456=\n"	=> "$x70!2345=\n6=3D\n"],
68
69   # Not allowed to break =XX escapes using soft line break
70   ["$x70===xxxxx"  => "$x70=3D=\n=3D=3Dxxxxx"],
71   ["$x70!===xxxx"  => "$x70!=3D=\n=3D=3Dxxxx"],
72   ["$x70!2===xxx"  => "$x70!2=3D=\n=3D=3Dxxx"],
73   ["$x70!23===xx"  => "$x70!23=\n=3D=3D=3Dxx"],
74   ["$x70!234===x"  => "$x70!234=\n=3D=3D=3Dx"],
75   ["$x70!2=\n"     => "$x70!2=3D\n"],
76   ["$x70!23=\n"    => "$x70!23=\n=3D\n"],
77   ["$x70!234=\n"   => "$x70!234=\n=3D\n"],
78   ["$x70!2345=\n"  => "$x70!2345=\n=3D\n"],
79   ["$x70!23456=\n" => "$x70!2345=\n6=3D\n"],
80   #                              ^
81   #                      70123456|
82   #                             max
83   #                          line width
84
85   # some extra special cases we have had problems with
86   ["$x70!2=x=x" => "$x70!2=3D=\nx=3Dx"],
87   ["$x70!2345$x70!2345$x70!23456\n", "$x70!2345=\n$x70!2345=\n$x70!23456\n"],
88
89   # trailing whitespace
90   ["foo \t ", "foo=20=09=20"],
91   ["foo\t \n \t", "foo=09=20\n=20=09"],
92);
93
94$notests = @tests + 13;
95print "1..$notests\n";
96
97$testno = 0;
98for (@tests) {
99    $testno++;
100    ($plain, $encoded) = @$_;
101    if (ord('A') == 193) {  # EBCDIC 8 bit chars are different
102        if ($testno == 2) { $plain =~ s/\xe5/\x47/; $plain =~ s/\xe6/\x9c/g; $plain =~ s/\xf8/\x70/; }
103        if ($testno == 7) { $plain =~ s/\xff/\xdf/; }
104    }
105    $x = encode_qp($plain);
106    if ($x ne $encoded) {
107	print "Encode test failed\n";
108	print "Got:      '$x'\n";
109	print "Expected: '$encoded'\n";
110	print "not ok $testno\n";
111	next;
112    }
113    $x = decode_qp($encoded);
114    if ($x ne $plain) {
115	print "Decode test failed\n";
116	print "Got:      '$x'\n";
117	print "Expected: '$plain'\n";
118	print "not ok $testno\n";
119	next;
120    }
121    print "ok $testno\n";
122}
123
124# Some extra testing for a case that was wrong until libwww-perl-5.09
125print "not " unless decode_qp("foo  \n\nfoo =\n\nfoo=20\n\n") eq
126                                "foo\n\nfoo \nfoo \n\n";
127$testno++; print "ok $testno\n";
128
129# Same test but with "\r\n" terminated lines
130print "not " unless decode_qp("foo  \r\n\r\nfoo =\r\n\r\nfoo=20\r\n\r\n") eq
131                                "foo\n\nfoo \nfoo \n\n";
132$testno++; print "ok $testno\n";
133
134# Trailing whitespace
135print "not " unless decode_qp("foo  ") eq "foo  ";
136$testno++; print "ok $testno\n";
137
138print "not " unless decode_qp("foo  \n") eq "foo\n";
139$testno++; print "ok $testno\n";
140
141print "not " unless decode_qp("foo = \t\x20\nbar\t\x20\n") eq "foo bar\n";
142$testno++; print "ok $testno\n";
143
144print "not " unless decode_qp("foo = \t\x20\r\nbar\t\x20\r\n") eq "foo bar\n";
145$testno++; print "ok $testno\n";
146
147print "not " unless decode_qp("foo = \t\x20\n") eq "foo ";
148$testno++; print "ok $testno\n";
149
150print "not " unless decode_qp("foo = \t\x20\r\n") eq "foo ";
151$testno++; print "ok $testno\n";
152
153print "not " unless decode_qp("foo = \t\x20y\r\n") eq "foo = \t\x20y\n";
154$testno++; print "ok $testno\n";
155
156print "not " unless decode_qp("foo =xy\n") eq "foo =xy\n";
157$testno++; print "ok $testno\n";
158
159# Test with with alternative line break
160print "not " unless encode_qp("$x70!2345$x70\n", "***") eq "$x70!2345=***$x70***";
161$testno++; print "ok $testno\n";
162
163# Test with no line breaks
164print "not " unless encode_qp("$x70!2345$x70\n", "") eq "$x70!2345$x70=0A";
165$testno++; print "ok $testno\n";
166
167print "not " if $] >= 5.006 && (eval 'encode_qp("XXX \x{100}")' || !$@);
168$testno++; print "ok $testno\n";
169