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    ["=\n" => "=3D\n"],
  29    ["\0\xff" => "=00=FF"],
  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!23\n"         => "$x70!23\n"],
  61    ["$x70!234\n"        => "$x70!234\n"],
  62    ["$x70!2345\n"       => "$x70!2345\n"],
  63    ["$x70!23456\n"      => "$x70!23456\n"],
  64
  65    # Not allowed to break =XX escapes using soft line break
  66    ["$x70===xxxx" => "$x70=3D=\n=3D=3Dxxxx"],
  67    ["$x70!===xxx" => "$x70!=3D=\n=3D=3Dxxx"],
  68    ["$x70!!===xx" => "$x70!!=3D=\n=3D=3Dxx"],
  69    ["$x70!!!===x" => "$x70!!!=\n=3D=3D=3Dx"],
  70    #                            ^
  71    #                    70123456|
  72    #                           max
  73    #                        line width
  74 );
  75
  76 $notests = @tests + 3;
  77 print "1..$notests\n";
  78
  79 $testno = 0;
  80 for (@tests) {
  81     $testno++;
  82     ($plain, $encoded) = @$_;
  83     if (ord('A') == 193) {  # EBCDIC 8 bit chars are different
  84         if ($testno == 2) { $plain =~ s/\xe5/\x47/; $plain =~ s/\xe6/\x9c/g; $plain =~ s/\xf8/\x70/; }
  85         if ($testno == 7) { $plain =~ s/\xff/\xdf/; }
  86     }
  87     $x = encode_qp($plain);
  88     if ($x ne $encoded) {
  89         print "Encode test failed\n";
  90         print "Got:      '$x'\n";
  91         print "Expected: '$encoded'\n";
  92         print "not ok $testno\n";
  93         next;
  94     }
  95     $x = decode_qp($encoded);
  96     if ($x ne $plain) {
  97         print "Decode test failed\n";
  98         print "Got:      '$x'\n";
  99         print "Expected: '$plain'\n";
 100         print "not ok $testno\n";
 101         next;
 102     }
 103     print "ok $testno\n";
 104 }
 105
 106 # Some extra testing for a case that was wrong until libwww-perl-5.09
 107 print "not " unless decode_qp("foo  \n\nfoo =\n\nfoo=20\n\n") eq
 108                                 "foo\n\nfoo \nfoo \n\n";
 109 $testno++; print "ok $testno\n";
 110
 111 # Same test but with "\r\n" terminated lines
 112 print "not " unless decode_qp("foo  \r\n\r\nfoo =\r\n\r\nfoo=20\r\n\r\n") eq
 113                                 "foo\r\n\r\nfoo \r\nfoo \r\n\r\n";
 114 $testno++; print "ok $testno\n";
 115
 116 print "not " if $] >= 5.006 && (eval 'encode_qp("XXX \x{100}")' || $@ !~ /^The Quoted-Printable encoding is only defined for bytes/);
 117 $testno++; print "ok $testno\n";