ext/MIME-Base64/t/quoted-print.t

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