xref: /openbsd-src/gnu/usr.bin/perl/cpan/Encode/t/mime-header.t (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9)
1b39c5158Smillert#
2*3d61058aSafresh1# $Id: mime-header.t,v 2.17 2023/11/10 01:10:50 dankogai Exp $
3b39c5158Smillert# This script is written in utf8
4b39c5158Smillert#
5b39c5158SmillertBEGIN {
6b39c5158Smillert    if ($ENV{'PERL_CORE'}){
7b39c5158Smillert        chdir 't';
8b39c5158Smillert        unshift @INC, '../lib';
9b39c5158Smillert    }
10*3d61058aSafresh1    require Config; Config->import();
11b39c5158Smillert    if ($Config{'extensions'} !~ /\bEncode\b/) {
12b39c5158Smillert      print "1..0 # Skip: Encode was not built\n";
13b39c5158Smillert      exit 0;
14b39c5158Smillert    }
15b39c5158Smillert    if (ord("A") == 193) {
16b39c5158Smillert    print "1..0 # Skip: EBCDIC\n";
17b39c5158Smillert    exit 0;
18b39c5158Smillert    }
19b39c5158Smillert    $| = 1;
20b39c5158Smillert}
21b39c5158Smillert
22b39c5158Smillertuse strict;
23b39c5158Smillert
24b39c5158Smillertuse utf8;
25b39c5158Smillertuse charnames ":full";
269f11ffb7Safresh1
27e0680481Safresh1use Test::More tests => 274;
289f11ffb7Safresh1
299f11ffb7Safresh1BEGIN {
309f11ffb7Safresh1    use_ok("Encode::MIME::Header");
31b39c5158Smillert}
32b39c5158Smillert
339f11ffb7Safresh1my @decode_long_tests;
349f11ffb7Safresh1if ($] < 5.009004) { # perl versions without Regular expressions Engine de-recursivised which cause stack overflow
359f11ffb7Safresh1    push(@decode_long_tests, "a" x 1000000 => "a" x 1000000);
369f11ffb7Safresh1    push(@decode_long_tests, "=?utf-8?Q?a?= " x 400 => "a" x 400 . " ");
379f11ffb7Safresh1    push(@decode_long_tests, "=?utf-8?Q?a?= =?US-ASCII?Q?b?= " x 200 => "ab" x 200 . " ");
389f11ffb7Safresh1} else {
399f11ffb7Safresh1    push(@decode_long_tests, "a" x 1000000 => "a" x 1000000);
409f11ffb7Safresh1    push(@decode_long_tests, "=?utf-8?Q?a?= " x 10000 => "a" x 10000 . " ");
419f11ffb7Safresh1    push(@decode_long_tests, "=?utf-8?Q?a?= =?US-ASCII?Q?b?= " x 10000 => "ab" x 10000 . " ");
429f11ffb7Safresh1}
43b39c5158Smillert
449f11ffb7Safresh1my @decode_tests = (
459f11ffb7Safresh1    # RFC2047 p.5
469f11ffb7Safresh1    "=?iso-8859-1?q?this=20is=20some=20text?=" => "this is some text",
479f11ffb7Safresh1    # RFC2047 p.10
489f11ffb7Safresh1    "=?US-ASCII?Q?Keith_Moore?=" => "Keith Moore",
499f11ffb7Safresh1    "=?ISO-8859-1?Q?Keld_J=F8rn_Simonsen?=" => "Keld Jørn Simonsen",
509f11ffb7Safresh1    "=?ISO-8859-1?Q?Andr=E9?= Pirard" => "André Pirard",
519f11ffb7Safresh1    "=?ISO-8859-1?B?SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=?=\r\n =?ISO-8859-2?B?dSB1bmRlcnN0YW5kIHRoZSBleGFtcGxlLg==?=" => "If you can read this you understand the example.",
529f11ffb7Safresh1    "=?ISO-8859-1?Q?Olle_J=E4rnefors?=" => "Olle Järnefors",
539f11ffb7Safresh1    "=?ISO-8859-1?Q?Patrik_F=E4ltstr=F6m?=" => "Patrik Fältström",
549f11ffb7Safresh1    # RFC2047 p.11
559f11ffb7Safresh1    "(=?iso-8859-8?b?7eXs+SDv4SDp7Oj08A==?=)" => "(םולש ןב ילטפנ)",
569f11ffb7Safresh1    "(=?ISO-8859-1?Q?a?=)" => "(a)",
579f11ffb7Safresh1    "(=?ISO-8859-1?Q?a?= b)" => "(a b)",
589f11ffb7Safresh1    "(=?ISO-8859-1?Q?a?= =?ISO-8859-1?Q?b?=)" => "(ab)",
599f11ffb7Safresh1    "(=?ISO-8859-1?Q?a?=  =?ISO-8859-1?Q?b?=)" => "(ab)",
609f11ffb7Safresh1    "(=?ISO-8859-1?Q?a?=\r\n\t=?ISO-8859-1?Q?b?=)" => "(ab)",
619f11ffb7Safresh1    # RFC2047 p.12
629f11ffb7Safresh1    "(=?ISO-8859-1?Q?a_b?=)" => '(a b)',
639f11ffb7Safresh1    "(=?ISO-8859-1?Q?a?= =?ISO-8859-2?Q?_b?=)" => "(a b)",
649f11ffb7Safresh1    # RFC2231 p.6
659f11ffb7Safresh1    "=?US-ASCII*EN?Q?Keith_Moore?=" => "Keith Moore",
669f11ffb7Safresh1    # others
679f11ffb7Safresh1    "=?US-ASCII*en-US?Q?Keith_Moore?=" => "Keith Moore",
689f11ffb7Safresh1    "=?ISO-8859-1*da-DK?Q?Keld_J=F8rn_Simonsen?=" => "Keld Jørn Simonsen",
699f11ffb7Safresh1    "=?ISO-8859-1*fr-BE?Q?Andr=E9?= Pirard" => "André Pirard",
709f11ffb7Safresh1    "=?ISO-8859-1*en?B?SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=?= =?ISO-8859-2?B?dSB1bmRlcnN0YW5kIHRoZSBleGFtcGxlLg==?=" => "If you can read this you understand the example.",
719f11ffb7Safresh1    # multiple (separated by CRLF)
729f11ffb7Safresh1    "=?US-ASCII?Q?a?=\r\n=?US-ASCII?Q?b?=" => "a\r\nb",
739f11ffb7Safresh1    "a\r\nb" => "a\r\nb",
749f11ffb7Safresh1    "a\r\n\r\nb" => "a\r\n\r\nb",
759f11ffb7Safresh1    "a\r\n\r\nb\r\n" => "a\r\n\r\nb\r\n",
769f11ffb7Safresh1    # multiple multiline (separated by CRLF)
779f11ffb7Safresh1    "=?US-ASCII?Q?a?=\r\n =?US-ASCII?Q?b?=\r\n=?US-ASCII?Q?c?=" => "ab\r\nc",
789f11ffb7Safresh1    "a\r\n b\r\nc" => "a b\r\nc",
799f11ffb7Safresh1    # RT67569
809f11ffb7Safresh1    "foo =?us-ascii?q?bar?=" => "foo bar",
819f11ffb7Safresh1    "foo\r\n =?us-ascii?q?bar?=" => "foo bar",
829f11ffb7Safresh1    "=?us-ascii?q?foo?= bar" => "foo bar",
839f11ffb7Safresh1    "=?us-ascii?q?foo?=\r\n bar" => "foo bar",
849f11ffb7Safresh1    "foo bar" => "foo bar",
859f11ffb7Safresh1    "foo\r\n bar" => "foo bar",
869f11ffb7Safresh1    "=?us-ascii?q?foo?= =?us-ascii?q?bar?=" => "foobar",
879f11ffb7Safresh1    "=?us-ascii?q?foo?=\r\n =?us-ascii?q?bar?=" => "foobar",
889f11ffb7Safresh1    # RT40027
899f11ffb7Safresh1    "a: b\r\n c" => "a: b c",
909f11ffb7Safresh1    # RT104422
919f11ffb7Safresh1    "=?utf-8?Q?pre?= =?utf-8?B?IGZvbw==?=\r\n =?utf-8?Q?bar?=" => "pre foobar",
929f11ffb7Safresh1    # RT114034 - replace invalid UTF-8 sequence with unicode replacement character
939f11ffb7Safresh1    "=?utf-8?Q?=f9=80=80=80=80?=" => "�",
949f11ffb7Safresh1    "=?utf-8?Q?=28=c3=29?=" => "(�)",
959f11ffb7Safresh1    # decode only known MIME charsets, do not crash on invalid
969f11ffb7Safresh1    "prefix =?unknown?Q?a=20b=20c?= middle =?US-ASCII?Q?d=20e=20f?= suffix" => "prefix =?unknown?Q?a=20b=20c?= middle d e f suffix",
979f11ffb7Safresh1    "prefix =?US-ASCII?Q?a_b_c?= =?unknown?Q?d_e_f?= suffix" => "prefix a b c =?unknown?Q?d_e_f?= suffix",
989f11ffb7Safresh1    "prefix =?US-ASCII?Q?a_b_c?= =?unknown?Q?d_e_f?= =?US-ASCII?Q?g_h_i?= suffix" => "prefix a b c =?unknown?Q?d_e_f?= g h i suffix",
999f11ffb7Safresh1    # long strings
1009f11ffb7Safresh1    @decode_long_tests,
1019f11ffb7Safresh1    # separators around encoded words
1029f11ffb7Safresh1    "\r\n =?US-ASCII?Q?a?=" => " a",
1039f11ffb7Safresh1    "\r\n (=?US-ASCII?Q?a?=)" => " (a)",
1049f11ffb7Safresh1    "\r\n (=?US-ASCII?Q?a?=)\r\n " => " (a) ",
1059f11ffb7Safresh1    "(=?US-ASCII?Q?a?=)\r\n " => "(a) ",
1069f11ffb7Safresh1    " (=?US-ASCII?Q?a?=) " => " (a) ",
1079f11ffb7Safresh1    "(=?US-ASCII?Q?a?=) " => "(a) ",
1089f11ffb7Safresh1    " (=?US-ASCII?Q?a?=)" => " (a)",
1099f11ffb7Safresh1    "(=?US-ASCII?Q?a?=)(=?US-ASCII?Q?b?=)" => "(a)(b)",
1109f11ffb7Safresh1    "(=?US-ASCII?Q?a?=) (=?US-ASCII?Q?b?=)" => "(a) (b)",
1119f11ffb7Safresh1    "(=?US-ASCII?Q?a?=)\r\n (=?US-ASCII?Q?b?=)" => "(a) (b)",
1129f11ffb7Safresh1    "\r\n (=?US-ASCII?Q?a?=)\r\n (=?US-ASCII?Q?b?=)\r\n " => " (a) (b) ",
1139f11ffb7Safresh1    "\r\n(=?US-ASCII?Q?a?=)\r\n(=?US-ASCII?Q?b?=)" => "\r\n(a)\r\n(b)",
1149f11ffb7Safresh1);
1159f11ffb7Safresh1
1169f11ffb7Safresh1my @decode_default_tests = (
1179f11ffb7Safresh1    @decode_tests,
1189f11ffb7Safresh1    "=?us-ascii?q?foo bar?=" => "foo bar",
1199f11ffb7Safresh1    "=?us-ascii?q?foo\r\n bar?=" => "foo bar",
1209f11ffb7Safresh1    '=?us-ascii?q?foo=20=3cbar=40baz=2efoo=3e=20bar?=' => 'foo <bar@baz.foo> bar',
1219f11ffb7Safresh1    '"=?us-ascii?q?foo=20=3cbar=40baz=2efoo=3e=20bar?="' => '"foo <bar@baz.foo> bar"',
1229f11ffb7Safresh1    "=?us-ascii?q?foo?==?us-ascii?q?bar?=" => "foobar",
1239f11ffb7Safresh1    "foo=?us-ascii?q?bar?=" => "foobar",
1249f11ffb7Safresh1    "foo =?us-ascii?q?=20?==?us-ascii?q?bar?=" => "foo  bar",
1259f11ffb7Safresh1    # Encode::MIME::Header pre 2.83
1269f11ffb7Safresh1    "[=?UTF-8?B?ZsOzcnVt?=]=?UTF-8?B?IHNwcsOhdmE=?=" => "[fórum] správa",
1279f11ffb7Safresh1    "test:=?UTF-8?B?IHNwcsOhdmE=?=" => "test: správa",
1289f11ffb7Safresh1    "=?UTF-8?B?dMOpc3Q=?=:=?UTF-8?B?IHNwcsOhdmE=?=", "tést: správa",
1299f11ffb7Safresh1    # multiple base64 parts in one b word
1309f11ffb7Safresh1    "=?us-ascii?b?Zg==Zg==?=" => "ff",
1319f11ffb7Safresh1    # b word with invalid characters
1329f11ffb7Safresh1    "=?us-ascii?b?Zm!!9!v?=" => "foo",
1339f11ffb7Safresh1    # concat consecutive words (with same parameters) and join them into one utf-8 symbol
1349f11ffb7Safresh1    "=?UTF-8?Q?=C3?= =?UTF-8?Q?=A1?=" => "á",
1359f11ffb7Safresh1    # RT114034 - use strict UTF-8 decoder for invalid MIME charsets utf8, UTF8 and utf-8-strict
1369f11ffb7Safresh1    "=?utf8?Q?=C3=A1=f9=80=80=80=80?=" => "á�",
1379f11ffb7Safresh1    "=?UTF8?Q?=C3=A1=f9=80=80=80=80?=" => "á�",
1389f11ffb7Safresh1    "=?utf-8-strict?Q?=C3=A1=f9=80=80=80=80?=" => "á�",
1399f11ffb7Safresh1    # allow non-ASCII characters in q word
1409f11ffb7Safresh1    "=?UTF-8?Q?\x{C3}\x{A1}?=" => "á",
141e0680481Safresh1    # allow missing padding characters '=' in b word
142e0680481Safresh1    "=?UTF-8?B?JQ?=" => "%",
143e0680481Safresh1    "=?UTF-8?B?JQ?= =?UTF-8?B?JQ?=" => "%%",
144e0680481Safresh1    "=?UTF-8?B?YWI?=" => "ab",
145e0680481Safresh1    "=?UTF-8?B?YWI?= =?UTF-8?B?YWI?=" => "abab",
1469f11ffb7Safresh1);
1479f11ffb7Safresh1
1489f11ffb7Safresh1my @decode_strict_tests = (
1499f11ffb7Safresh1    @decode_tests,
1509f11ffb7Safresh1    "=?us-ascii?q?foo bar?=" => "=?us-ascii?q?foo bar?=",
1519f11ffb7Safresh1    "=?us-ascii?q?foo\r\n bar?=" => "=?us-ascii?q?foo bar?=",
1529f11ffb7Safresh1    '=?us-ascii?q?foo=20=3cbar=40baz=2efoo=3e=20bar?=' => 'foo <bar@baz.foo> bar',
1539f11ffb7Safresh1    '"=?us-ascii?q?foo=20=3cbar=40baz=2efoo=3e=20bar?="' => '"=?us-ascii?q?foo=20=3cbar=40baz=2efoo=3e=20bar?="',
1549f11ffb7Safresh1    # do not decode invalid q words
1559f11ffb7Safresh1    "=?us-ascii?q?foo=?=" => "=?us-ascii?q?foo=?=",
1569f11ffb7Safresh1    "=?us-ascii?q?foo=?= =?us-ascii?q?foo?=" => "=?us-ascii?q?foo=?= foo",
1579f11ffb7Safresh1    # do not decode invalid b words
1589f11ffb7Safresh1    "=?us-ascii?b?----?=" => "=?us-ascii?b?----?=",
1599f11ffb7Safresh1    "=?us-ascii?b?Zm8=-?= =?us-ascii?b?Zm9v?= and =?us-ascii?b?Zg==?=" => "=?us-ascii?b?Zm8=-?= foo and f",
1609f11ffb7Safresh1    "=?us-ascii?b?----?= =?us-ascii?b?Zm9v?= and =?us-ascii?b?Zg==?=" => "=?us-ascii?b?----?= foo and f",
1619f11ffb7Safresh1    # RT114034 - utf8, UTF8 and also utf-8-strict are invalid MIME charset, do not decode it
1629f11ffb7Safresh1    "=?utf8?Q?=C3=A1?=" => "=?utf8?Q?=C3=A1?=",
1639f11ffb7Safresh1    "=?UTF8?Q?=C3=A1?=" => "=?UTF8?Q?=C3=A1?=",
1649f11ffb7Safresh1    "=?utf-8-strict?Q?=C3=A1?=" => "=?utf-8-strict?Q?=C3=A1?=",
1659f11ffb7Safresh1    # do not allow non-ASCII characters in q word
1669f11ffb7Safresh1    "=?UTF-8?Q?\x{C3}\x{A1}?=" => "=?UTF-8?Q?\x{C3}\x{A1}?=",
167e0680481Safresh1    # do not allow missing padding characters '=' in b word
168e0680481Safresh1    "=?UTF-8?B?JQ?=" => "=?UTF-8?B?JQ?=",
169e0680481Safresh1    "=?UTF-8?B?JQ?= =?UTF-8?B?JQ?=" => "=?UTF-8?B?JQ?= =?UTF-8?B?JQ?=",
170e0680481Safresh1    "=?UTF-8?B?YWI?=" => "=?UTF-8?B?YWI?=",
171e0680481Safresh1    "=?UTF-8?B?YWI?= =?UTF-8?B?YWI?=" => "=?UTF-8?B?YWI?= =?UTF-8?B?YWI?=",
1729f11ffb7Safresh1);
1739f11ffb7Safresh1
1749f11ffb7Safresh1my @encode_tests = (
1759f11ffb7Safresh1    "小飼 弾" => "=?UTF-8?B?5bCP6aO8IOW8vg==?=", "=?UTF-8?Q?=E5=B0=8F=E9=A3=BC_=E5=BC=BE?=",
1769f11ffb7Safresh1    "漢字、カタカナ、ひらがなを含む、非常に長いタイトル行が一体全体どのようにしてEncodeされるのか?" => "=?UTF-8?B?5ryi5a2X44CB44Kr44K/44Kr44OK44CB44Gy44KJ44GM44Gq44KS5ZCr44KA?=\r\n =?UTF-8?B?44CB6Z2e5bi444Gr6ZW344GE44K/44Kk44OI44Or6KGM44GM5LiA5L2T5YWo?=\r\n =?UTF-8?B?5L2T44Gp44Gu44KI44GG44Gr44GX44GmRW5jb2Rl44GV44KM44KL44Gu44GL?=\r\n =?UTF-8?B?77yf?=", "=?UTF-8?Q?=E6=BC=A2=E5=AD=97=E3=80=81=E3=82=AB=E3=82=BF=E3=82=AB=E3=83=8A?=\r\n =?UTF-8?Q?=E3=80=81=E3=81=B2=E3=82=89=E3=81=8C=E3=81=AA=E3=82=92=E5=90=AB?=\r\n =?UTF-8?Q?=E3=82=80=E3=80=81=E9=9D=9E=E5=B8=B8=E3=81=AB=E9=95=B7=E3=81=84?=\r\n =?UTF-8?Q?=E3=82=BF=E3=82=A4=E3=83=88=E3=83=AB=E8=A1=8C=E3=81=8C=E4=B8=80?=\r\n =?UTF-8?Q?=E4=BD=93=E5=85=A8=E4=BD=93=E3=81=A9=E3=81=AE=E3=82=88=E3=81=86?=\r\n =?UTF-8?Q?=E3=81=AB=E3=81=97=E3=81=A6Encode=E3=81=95=E3=82=8C=E3=82=8B?=\r\n =?UTF-8?Q?=E3=81=AE=E3=81=8B=EF=BC=9F?=",
1779f11ffb7Safresh1    # double encode
1789f11ffb7Safresh1    "What is =?UTF-8?B?w4RwZmVs?= ?" => "=?UTF-8?B?V2hhdCBpcyA9P1VURi04P0I/dzRSd1ptVnM/PSA/?=", "=?UTF-8?Q?What_is_=3D=3FUTF-8=3FB=3Fw4RwZmVs=3F=3D_=3F?=",
1799f11ffb7Safresh1    # pound 1024
1809f11ffb7Safresh1    "\N{POUND SIGN}1024" => "=?UTF-8?B?wqMxMDI0?=", "=?UTF-8?Q?=C2=A31024?=",
1819f11ffb7Safresh1    # latin1 characters
1829f11ffb7Safresh1    "\x{fc}" => "=?UTF-8?B?w7w=?=", "=?UTF-8?Q?=C3=BC?=",
183b39c5158Smillert    # RT42627
1849f11ffb7Safresh1    Encode::decode_utf8("\x{c2}\x{a3}xxxxxxxxxxxxxxxxxxx0") => "=?UTF-8?B?wqN4eHh4eHh4eHh4eHh4eHh4eHh4MA==?=", "=?UTF-8?Q?=C2=A3xxxxxxxxxxxxxxxxxxx0?=",
185e5157e49Safresh1    # RT87831
1869f11ffb7Safresh1    "0" => "=?UTF-8?B?MA==?=", "=?UTF-8?Q?0?=",
1879f11ffb7Safresh1    # RT88717
1889f11ffb7Safresh1    "Hey foo\x{2024}bar:whee" => "=?UTF-8?B?SGV5IGZvb+KApGJhcjp3aGVl?=", "=?UTF-8?Q?Hey_foo=E2=80=A4bar=3Awhee?=",
1899f11ffb7Safresh1    # valid q chars
1909f11ffb7Safresh1    "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz !*+-/" => "=?UTF-8?B?MDEyMzQ1Njc4OUFCQ0RFRkdISUpLTE1OT1BRUlNUVVZXWFlaYWJjZGVmZ2hp?=\r\n =?UTF-8?B?amtsbW5vcHFyc3R1dnd4eXogISorLS8=?=", "=?UTF-8?Q?0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_?=\r\n =?UTF-8?Q?!*+-/?=",
1919f11ffb7Safresh1    # invalid q chars
1929f11ffb7Safresh1    "." => "=?UTF-8?B?Lg==?=", "=?UTF-8?Q?=2E?=",
1939f11ffb7Safresh1    "," => "=?UTF-8?B?LA==?=", "=?UTF-8?Q?=2C?=",
1949f11ffb7Safresh1    # long ascii sequence
1959f11ffb7Safresh1    "a" x 100 => "=?UTF-8?B?YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFh?=\r\n =?UTF-8?B?YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFh?=\r\n =?UTF-8?B?YWFhYWFhYWFhYQ==?=", "=?UTF-8?Q?aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa?=\r\n =?UTF-8?Q?aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa?=",
1969f11ffb7Safresh1    # long unicode sequence
1979f11ffb7Safresh1    "��" x 100 => "=?UTF-8?B?8J+YgPCfmIDwn5iA8J+YgPCfmIDwn5iA8J+YgPCfmIDwn5iA8J+YgPCfmIA=?=\r\n " x 9 . "=?UTF-8?B?8J+YgA==?=", join("\r\n ", ("=?UTF-8?Q?=F0=9F=98=80=F0=9F=98=80=F0=9F=98=80=F0=9F=98=80=F0=9F=98=80?=") x 20),
1989f11ffb7Safresh1);
1999f11ffb7Safresh1
2009f11ffb7Safresh1sub info {
2019f11ffb7Safresh1    my ($str, $str1, $str2) = @_;
2029f11ffb7Safresh1    substr $str1, 1000, -3, "..." if defined $str1 and length $str1 > 1000;
2039f11ffb7Safresh1    substr $str2, 1000, -3, "..." if defined $str2 and length $str2 > 1000;
2049f11ffb7Safresh1    $str .= ": $str1" if defined $str1;
2059f11ffb7Safresh1    $str .= " => $str2" if defined $str2;
2069f11ffb7Safresh1    $str = Encode::encode_utf8($str);
2079f11ffb7Safresh1    $str =~ s/\r/\\r/gs;
2089f11ffb7Safresh1    $str =~ s/\n/\\n/gs;
2099f11ffb7Safresh1    return $str;
2109f11ffb7Safresh1}
2119f11ffb7Safresh1
2129f11ffb7Safresh1sub check_length {
2139f11ffb7Safresh1    my ($str) = @_;
2149f11ffb7Safresh1    my @lines = split /\r\n /, $str;
2159f11ffb7Safresh1    my @long = grep { length($_) > 75 } @lines;
2169f11ffb7Safresh1    return scalar @long == 0;
2179f11ffb7Safresh1}
2189f11ffb7Safresh1
2199f11ffb7Safresh1my @splice;
2209f11ffb7Safresh1
2219f11ffb7Safresh1@splice = @encode_tests;
2229f11ffb7Safresh1while (my ($d, $b, $q) = splice @splice, 0, 3) {
2239f11ffb7Safresh1    is Encode::encode("MIME-Header", $d) => $b, info("encode default", $d => $b);
2249f11ffb7Safresh1    is Encode::encode("MIME-B", $d) => $b, info("encode base64", $d => $b);
2259f11ffb7Safresh1    is Encode::encode("MIME-Q", $d) => $q, info("encode qp", $d => $q);
2269f11ffb7Safresh1    is Encode::decode("MIME-B", $b) => $d, info("decode base64", $b => $d);
2279f11ffb7Safresh1    is Encode::decode("MIME-Q", $q) => $d, info("decode qp", $b => $d);
2289f11ffb7Safresh1    ok check_length($b), info("correct encoded length base64", $b);
2299f11ffb7Safresh1    ok check_length($q), info("correct encoded length qp", $q);
2309f11ffb7Safresh1}
2319f11ffb7Safresh1
2329f11ffb7Safresh1@splice = @decode_default_tests;
2339f11ffb7Safresh1while (my ($e, $d) = splice @splice, 0, 2) {
2349f11ffb7Safresh1    is Encode::decode("MIME-Header", $e) => $d, info("decode default", $e => $d);
2359f11ffb7Safresh1}
2369f11ffb7Safresh1
2379f11ffb7Safresh1local $Encode::MIME::Header::STRICT_DECODE = 1;
2389f11ffb7Safresh1
2399f11ffb7Safresh1@splice = @decode_strict_tests;
2409f11ffb7Safresh1while (my ($e, $d) = splice @splice, 0, 2) {
2419f11ffb7Safresh1    is Encode::decode("MIME-Header", $e) => $d, info("decode strict", $e => $d);
2429f11ffb7Safresh1}
2439f11ffb7Safresh1
2449f11ffb7Safresh1my $valid_unicode = "á";
2459f11ffb7Safresh1my $invalid_unicode = "\x{1000000}";
2469f11ffb7Safresh1{
2479f11ffb7Safresh1    my $input = $valid_unicode;
2489f11ffb7Safresh1    my $output = Encode::encode("MIME-Header", $input, Encode::FB_QUIET);
2499f11ffb7Safresh1    is $output => Encode::encode("MIME-Header", $valid_unicode), "encode valid with FB_QUIET flag: output string is valid";
2509f11ffb7Safresh1    is $input => "", "encode valid with FB_QUIET flag: input string is modified and empty";
2519f11ffb7Safresh1}
2529f11ffb7Safresh1{
2539f11ffb7Safresh1    my $input = $valid_unicode . $invalid_unicode;
2549f11ffb7Safresh1    my $output = Encode::encode("MIME-Header", $input, Encode::FB_QUIET);
2559f11ffb7Safresh1    is $output => Encode::encode("MIME-Header", $valid_unicode), "encode with FB_QUIET flag: output string stops before first invalid character";
2569f11ffb7Safresh1    is $input => $invalid_unicode, "encode with FB_QUIET flag: input string is modified and starts with first invalid character";
2579f11ffb7Safresh1}
2589f11ffb7Safresh1{
2599f11ffb7Safresh1    my $input = $valid_unicode . $invalid_unicode;
2609f11ffb7Safresh1    my $output = Encode::encode("MIME-Header", $input, Encode::FB_QUIET | Encode::LEAVE_SRC);
2619f11ffb7Safresh1    is $output => Encode::encode("MIME-Header", $valid_unicode), "encode with FB_QUIET and LEAVE_SRC flags: output string stops before first invalid character";
2629f11ffb7Safresh1    is $input => $valid_unicode . $invalid_unicode, "encode with FB_QUIET and LEAVE_SRC flags: input string is not modified";
2639f11ffb7Safresh1}
2649f11ffb7Safresh1{
2659f11ffb7Safresh1    my $input = $valid_unicode . $invalid_unicode;
2669f11ffb7Safresh1    my $output = Encode::encode("MIME-Header", $input, Encode::FB_PERLQQ);
2679f11ffb7Safresh1    is $output => Encode::encode("MIME-Header", $valid_unicode . '\x{1000000}'), "encode with FB_PERLQQ flag: output string contains perl qq representation of invalid character";
2689f11ffb7Safresh1    is $input => $valid_unicode . $invalid_unicode, "encode with FB_PERLQQ flag: input string is not modified";
2699f11ffb7Safresh1}
2709f11ffb7Safresh1{
2719f11ffb7Safresh1    my $input = $valid_unicode;
2729f11ffb7Safresh1    my $output = Encode::encode("MIME-Header", $input, sub { sprintf("!0x%X!", $_[0]) });
2739f11ffb7Safresh1    is $output => Encode::encode("MIME-Header", $valid_unicode), "encode valid with coderef check: output string is valid";
2749f11ffb7Safresh1    is $input => $valid_unicode, "encode valid with coderef check: input string is not modified";
2759f11ffb7Safresh1}
2769f11ffb7Safresh1{
2779f11ffb7Safresh1    my $input = $valid_unicode . $invalid_unicode;
2789f11ffb7Safresh1    my $output = Encode::encode("MIME-Header", $input, sub { sprintf("!0x%X!", $_[0]) });
2799f11ffb7Safresh1    is $output => Encode::encode("MIME-Header", $valid_unicode . '!0x1000000!'), "encode with coderef check: output string contains output from coderef";
2809f11ffb7Safresh1    is $input => $valid_unicode . $invalid_unicode, "encode with coderef check: input string is not modified";
2819f11ffb7Safresh1}
2829f11ffb7Safresh1
2839f11ffb7Safresh1my $valid_mime = "=?US-ASCII?Q?d=20e=20f?=";
2849f11ffb7Safresh1my $invalid_mime = "=?unknown?Q?a=20b=20c?=";
2859f11ffb7Safresh1my $invalid_mime_unicode = "=?utf-8?Q?=28=c3=29?=";
2869f11ffb7Safresh1{
2879f11ffb7Safresh1    my $input = $valid_mime;
2889f11ffb7Safresh1    my $output = Encode::decode("MIME-Header", $input, Encode::FB_QUIET);
2899f11ffb7Safresh1    is $output => Encode::decode("MIME-Header", $valid_mime), "decode valid with FB_QUIET flag: output string is valid";
2909f11ffb7Safresh1    is $input => "", "decode valid with FB_QUIET flag: input string is modified and empty";
2919f11ffb7Safresh1}
2929f11ffb7Safresh1{
2939f11ffb7Safresh1    my $input = $valid_mime . " " . $invalid_mime;
2949f11ffb7Safresh1    my $output = Encode::decode("MIME-Header", $input, Encode::FB_QUIET);
2959f11ffb7Safresh1    is $output => Encode::decode("MIME-Header", $valid_mime), "decode with FB_QUIET flag: output string stops before first mime word with unknown charset";
2969f11ffb7Safresh1    is $input => $invalid_mime, "decode with FB_QUIET flag: input string is modified and starts with first mime word with unknown charset";
2979f11ffb7Safresh1}
2989f11ffb7Safresh1{
2999f11ffb7Safresh1    my $input = $valid_mime . " " . $invalid_mime_unicode;
3009f11ffb7Safresh1    my $output = Encode::decode("MIME-Header", $input, Encode::FB_QUIET);
3019f11ffb7Safresh1    is $output => Encode::decode("MIME-Header", $valid_mime), "decode with FB_QUIET flag: output string stops before first mime word with invalid unicode character";
3029f11ffb7Safresh1    is $input => $invalid_mime_unicode, "decode with FB_QUIET flag: input string is modified and starts with first mime word with invalid unicode character";
3039f11ffb7Safresh1}
3049f11ffb7Safresh1{
3059f11ffb7Safresh1    my $input = $valid_mime . " " . $invalid_mime;
3069f11ffb7Safresh1    my $output = Encode::decode("MIME-Header", $input, Encode::FB_QUIET | Encode::LEAVE_SRC);
3079f11ffb7Safresh1    is $output => Encode::decode("MIME-Header", $valid_mime), "decode with FB_QUIET and LEAVE_SRC flags: output string stops before first mime word with unknown charset";
3089f11ffb7Safresh1    is $input => $valid_mime . " " . $invalid_mime, "decode with FB_QUIET flag: input string is not modified";
3099f11ffb7Safresh1}
3109f11ffb7Safresh1{
3119f11ffb7Safresh1    my $input = $valid_mime . " " . $invalid_mime_unicode;
3129f11ffb7Safresh1    my $output = Encode::decode("MIME-Header", $input, Encode::FB_QUIET | Encode::LEAVE_SRC);
3139f11ffb7Safresh1    is $output => Encode::decode("MIME-Header", $valid_mime), "decode with FB_QUIET and LEAVE_SRC flags: output string stops before first mime word with invalid unicode character";
3149f11ffb7Safresh1    is $input => $valid_mime . " " . $invalid_mime_unicode, "decode with FB_QUIET flag: input string is not modified";
3159f11ffb7Safresh1}
3169f11ffb7Safresh1{
3179f11ffb7Safresh1    my $input = $valid_mime . " " . $invalid_mime;
3189f11ffb7Safresh1    my $output = Encode::decode("MIME-Header", $input, Encode::FB_PERLQQ);
3199f11ffb7Safresh1    is $output => Encode::decode("MIME-Header", $valid_mime) . " " . $invalid_mime, "decode with FB_PERLQQ flag: output string contains unmodified mime word with unknown charset";
3209f11ffb7Safresh1    is $input => $valid_mime . " " . $invalid_mime, "decode with FB_QUIET flag: input string is not modified";
3219f11ffb7Safresh1}
3229f11ffb7Safresh1{
3239f11ffb7Safresh1    my $input = $valid_mime . " " . $invalid_mime_unicode;
3249f11ffb7Safresh1    my $output = Encode::decode("MIME-Header", $input, Encode::FB_PERLQQ);
3259f11ffb7Safresh1    is $output => Encode::decode("MIME-Header", $valid_mime) . '(\xC3)', "decode with FB_PERLQQ flag: output string contains perl qq representation of invalid unicode character";
3269f11ffb7Safresh1    is $input => $valid_mime . " " . $invalid_mime_unicode, "decode with FB_QUIET flag: input string is not modified";
3279f11ffb7Safresh1}
3289f11ffb7Safresh1{
3299f11ffb7Safresh1    my $input = $valid_mime;
3309f11ffb7Safresh1    my $output = Encode::decode("MIME-Header", $input, sub { sprintf("!0x%X!", $_[0]) });
3319f11ffb7Safresh1    is $output => Encode::decode("MIME-Header", $valid_mime), "decode valid with coderef check: output string is valid";
3329f11ffb7Safresh1    is $input => $valid_mime, "decode valid with coderef check: input string is not modified";
3339f11ffb7Safresh1}
3349f11ffb7Safresh1{
3359f11ffb7Safresh1    my $input = $valid_mime . " " . $invalid_mime;
3369f11ffb7Safresh1    my $output = Encode::decode("MIME-Header", $input, sub { sprintf("!0x%X!", $_[0]) });
3379f11ffb7Safresh1    is $output => Encode::decode("MIME-Header", $valid_mime) . " " . $invalid_mime, "decode with coderef check: output string contains unmodified mime word with unknown charset";
3389f11ffb7Safresh1    is $input => $valid_mime . " " . $invalid_mime, "decode with coderef check: input string is not modified";
3399f11ffb7Safresh1}
3409f11ffb7Safresh1{
3419f11ffb7Safresh1    my $input = $valid_mime . " " . $invalid_mime_unicode;
3429f11ffb7Safresh1    my $output = Encode::decode("MIME-Header", $input, sub { sprintf("!0x%X!", $_[0]) });
3439f11ffb7Safresh1    is $output => Encode::decode("MIME-Header", $valid_mime) . '(!0xC3!)', "decode with coderef check: output string contains output from coderef for invalid unicode character";
3449f11ffb7Safresh1    is $input => $valid_mime . " " . $invalid_mime_unicode, "decode with coderef check: input string is not modified";
3459f11ffb7Safresh1}
3469f11ffb7Safresh1
3479f11ffb7Safresh1__END__
348