t/lib/mimeqp.t

   1 BEGIN {
   2         chdir 't' if -d 't';
   3         @INC = '../lib';
   4 }
   5
   6 use MIME::QuotedPrint;
   7
   8 $x70 = "x" x 70;
   9
  10 @tests =
  11   (
  12    # plain ascii should not be encoded
  13    ["quoted printable"  =>
  14     "quoted printable"],
  15
  16    # 8-bit chars should be encoded
  17    ["v\xe5re kj\xe6re norske tegn b\xf8r \xe6res" =>
  18     "v=E5re kj=E6re norske tegn b=F8r =E6res"],
  19
  20    # trailing space should be encoded
  21    ["  " => "=20=20"],
  22    ["\tt\t" => "\tt=09"],
  23    ["test  \ntest\n\t \t \n" => "test=20=20\ntest\n=09=20=09=20\n"],
  24
  25    # "=" is special an should be decoded
  26    ["=\n" => "=3D\n"],
  27    ["\0\xff" => "=00=FF"],
  28
  29    # Very long lines should be broken (not more than 76 chars
  30    ["The Quoted-Printable encoding is intended to represent data that largly consists of octets that correspond to printable characters in the ASCII character set." =>
  31     "The Quoted-Printable encoding is intended to represent data that largly con=
  32 sists of octets that correspond to printable characters in the ASCII charac=
  33 ter set."
  34     ],
  35
  36    # Long lines after short lines were broken through 2.01.
  37    ["short line
  38 In America, any boy may become president and I suppose that's just one of the risks he takes. -- Adlai Stevenson" =>
  39     "short line
  40 In America, any boy may become president and I suppose that's just one of t=
  41 he risks he takes. -- Adlai Stevenson"],
  42
  43    # My (roderick@argon.org) first crack at fixing that bug failed for
  44    # multiple long lines.
  45    ["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
  46 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" =>
  47     "College football is a game which would be much more interesting if the facu=
  48 lty played instead of the students, and even more interesting if the
  49 trustees played.  There would be a great increase in broken arms, legs, and=
  50  necks, and simultaneously an appreciable diminution in the loss to humanit=
  51 y. -- H. L. Mencken"],
  52
  53    # Don't break a line that's near but not over 76 chars.
  54    ["$x70!23"           => "$x70!23"],
  55    ["$x70!234"          => "$x70!234"],
  56    ["$x70!2345"         => "$x70!2345"],
  57    ["$x70!23456"        => "$x70!23456"],
  58    ["$x70!23\n"         => "$x70!23\n"],
  59    ["$x70!234\n"        => "$x70!234\n"],
  60    ["$x70!2345\n"       => "$x70!2345\n"],
  61    ["$x70!23456\n"      => "$x70!23456\n"],
  62
  63    # Not allowed to break =XX escapes using soft line break
  64    ["$x70===xxxx" => "$x70=3D=\n=3D=3Dxxxx"],
  65    ["$x70!===xxx" => "$x70!=3D=\n=3D=3Dxxx"],
  66    ["$x70!!===xx" => "$x70!!=3D=\n=3D=3Dxx"],
  67    ["$x70!!!===x" => "$x70!!!=\n=3D=3D=3Dx"],
  68    #                            ^
  69    #                    70123456|
  70    #                           max
  71    #                        line width
  72 );
  73
  74 $notests = @tests + 2;
  75 print "1..$notests\n";
  76
  77 $testno = 0;
  78 for (@tests) {
  79     $testno++;
  80     ($plain, $encoded) = @$_;
  81     if (ord('A') == 193) {  # EBCDIC 8 bit chars are different
  82         if ($testno == 2) { $plain =~ s/\xe5/\x47/; $plain =~ s/\xe6/\x9c/g; $plain =~ s/\xf8/\x70/; }
  83         if ($testno == 7) { $plain =~ s/\xff/\xdf/; }
  84     }
  85     $x = encode_qp($plain);
  86     if ($x ne $encoded) {
  87         print "Encode test failed\n";
  88         print "Got:      '$x'\n";
  89         print "Expected: '$encoded'\n";
  90         print "not ok $testno\n";
  91         next;
  92     }
  93     $x = decode_qp($encoded);
  94     if ($x ne $plain) {
  95         print "Decode test failed\n";
  96         print "Got:      '$x'\n";
  97         print "Expected: '$plain'\n";
  98         print "not ok $testno\n";
  99         next;
 100     }
 101     print "ok $testno\n";
 102 }
 103
 104 # Some extra testing for a case that was wrong until libwww-perl-5.09
 105 print "not " unless decode_qp("foo  \n\nfoo =\n\nfoo=20\n\n") eq
 106                                 "foo\n\nfoo \nfoo \n\n";
 107 $testno++; print "ok $testno\n";
 108
 109 # Same test but with "\r\n" terminated lines
 110 print "not " unless decode_qp("foo  \r\n\r\nfoo =\r\n\r\nfoo=20\r\n\r\n") eq
 111                                 "foo\r\n\r\nfoo \r\nfoo \r\n\r\n";
 112 $testno++; print "ok $testno\n";
 113