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