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 @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=
  34 sists of octets that correspond to printable characters in the ASCII charac=
  35 ter set."
  36     ],
  37
  38    # Long lines after short lines were broken through 2.01.
  39    ["short line
  40 In America, any boy may become president and I suppose that's just one of the risks he takes. -- Adlai Stevenson" =>
  41     "short line
  42 In America, any boy may become president and I suppose that's just one of t=
  43 he 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
  48 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" =>
  49     "College football is a game which would be much more interesting if the facu=
  50 lty played instead of the students, and even more interesting if the
  51 trustees played.  There would be a great increase in broken arms, legs, and=
  52  necks, and simultaneously an appreciable diminution in the loss to humanit=
  53 y. -- 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
  90 $notests = @tests + 3;
  91 print "1..$notests\n";
  92
  93 $testno = 0;
  94 for (@tests) {
  95     $testno++;
  96     ($plain, $encoded) = @$_;
  97     if (ord('A') == 193) {  # EBCDIC 8 bit chars are different
  98         if ($testno == 2) { $plain =~ s/\xe5/\x47/; $plain =~ s/\xe6/\x9c/g; $plain =~ s/\xf8/\x70/; }
  99         if ($testno == 7) { $plain =~ s/\xff/\xdf/; }
 100     }
 101     $x = encode_qp($plain);
 102     if ($x ne $encoded) {
 103         print "Encode test failed\n";
 104         print "Got:      '$x'\n";
 105         print "Expected: '$encoded'\n";
 106         print "not ok $testno\n";
 107         next;
 108     }
 109     $x = decode_qp($encoded);
 110     if ($x ne $plain) {
 111         print "Decode test failed\n";
 112         print "Got:      '$x'\n";
 113         print "Expected: '$plain'\n";
 114         print "not ok $testno\n";
 115         next;
 116     }
 117     print "ok $testno\n";
 118 }
 119
 120 # Some extra testing for a case that was wrong until libwww-perl-5.09
 121 print "not " unless decode_qp("foo  \n\nfoo =\n\nfoo=20\n\n") eq
 122                                 "foo\n\nfoo \nfoo \n\n";
 123 $testno++; print "ok $testno\n";
 124
 125 # Same test but with "\r\n" terminated lines
 126 print "not " unless decode_qp("foo  \r\n\r\nfoo =\r\n\r\nfoo=20\r\n\r\n") eq
 127                                 "foo\n\nfoo \nfoo \n\n";
 128 $testno++; print "ok $testno\n";
 129
 130 print "not " if $] >= 5.006 && (eval 'encode_qp("XXX \x{100}")' || !$@);
 131 $testno++; print "ok $testno\n";