"Fossies" - the Fresh Open Source Software Archive

Member "MIME-Base64-3.16/t/quoted-print.t" (27 Sep 2020, 13637 Bytes) of package /linux/privat/MIME-Base64-3.16.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "quoted-print.t": 3.15_vs_3.16.

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