1# 2# $Id: mime-header.t,v 2.16 2022/06/25 01:58:57 dankogai Exp $ 3# This script is written in utf8 4# 5BEGIN { 6 if ($ENV{'PERL_CORE'}){ 7 chdir 't'; 8 unshift @INC, '../lib'; 9 } 10 require Config; import Config; 11 if ($Config{'extensions'} !~ /\bEncode\b/) { 12 print "1..0 # Skip: Encode was not built\n"; 13 exit 0; 14 } 15 if (ord("A") == 193) { 16 print "1..0 # Skip: EBCDIC\n"; 17 exit 0; 18 } 19 $| = 1; 20} 21 22use strict; 23 24use utf8; 25use charnames ":full"; 26 27use Test::More tests => 274; 28 29BEGIN { 30 use_ok("Encode::MIME::Header"); 31} 32 33my @decode_long_tests; 34if ($] < 5.009004) { # perl versions without Regular expressions Engine de-recursivised which cause stack overflow 35 push(@decode_long_tests, "a" x 1000000 => "a" x 1000000); 36 push(@decode_long_tests, "=?utf-8?Q?a?= " x 400 => "a" x 400 . " "); 37 push(@decode_long_tests, "=?utf-8?Q?a?= =?US-ASCII?Q?b?= " x 200 => "ab" x 200 . " "); 38} else { 39 push(@decode_long_tests, "a" x 1000000 => "a" x 1000000); 40 push(@decode_long_tests, "=?utf-8?Q?a?= " x 10000 => "a" x 10000 . " "); 41 push(@decode_long_tests, "=?utf-8?Q?a?= =?US-ASCII?Q?b?= " x 10000 => "ab" x 10000 . " "); 42} 43 44my @decode_tests = ( 45 # RFC2047 p.5 46 "=?iso-8859-1?q?this=20is=20some=20text?=" => "this is some text", 47 # RFC2047 p.10 48 "=?US-ASCII?Q?Keith_Moore?=" => "Keith Moore", 49 "=?ISO-8859-1?Q?Keld_J=F8rn_Simonsen?=" => "Keld J��rn Simonsen", 50 "=?ISO-8859-1?Q?Andr=E9?= Pirard" => "Andr�� Pirard", 51 "=?ISO-8859-1?B?SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=?=\r\n =?ISO-8859-2?B?dSB1bmRlcnN0YW5kIHRoZSBleGFtcGxlLg==?=" => "If you can read this you understand the example.", 52 "=?ISO-8859-1?Q?Olle_J=E4rnefors?=" => "Olle J��rnefors", 53 "=?ISO-8859-1?Q?Patrik_F=E4ltstr=F6m?=" => "Patrik F��ltstr��m", 54 # RFC2047 p.11 55 "(=?iso-8859-8?b?7eXs+SDv4SDp7Oj08A==?=)" => "(�������� ���� ����������)", 56 "(=?ISO-8859-1?Q?a?=)" => "(a)", 57 "(=?ISO-8859-1?Q?a?= b)" => "(a b)", 58 "(=?ISO-8859-1?Q?a?= =?ISO-8859-1?Q?b?=)" => "(ab)", 59 "(=?ISO-8859-1?Q?a?= =?ISO-8859-1?Q?b?=)" => "(ab)", 60 "(=?ISO-8859-1?Q?a?=\r\n\t=?ISO-8859-1?Q?b?=)" => "(ab)", 61 # RFC2047 p.12 62 "(=?ISO-8859-1?Q?a_b?=)" => '(a b)', 63 "(=?ISO-8859-1?Q?a?= =?ISO-8859-2?Q?_b?=)" => "(a b)", 64 # RFC2231 p.6 65 "=?US-ASCII*EN?Q?Keith_Moore?=" => "Keith Moore", 66 # others 67 "=?US-ASCII*en-US?Q?Keith_Moore?=" => "Keith Moore", 68 "=?ISO-8859-1*da-DK?Q?Keld_J=F8rn_Simonsen?=" => "Keld J��rn Simonsen", 69 "=?ISO-8859-1*fr-BE?Q?Andr=E9?= Pirard" => "Andr�� Pirard", 70 "=?ISO-8859-1*en?B?SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=?= =?ISO-8859-2?B?dSB1bmRlcnN0YW5kIHRoZSBleGFtcGxlLg==?=" => "If you can read this you understand the example.", 71 # multiple (separated by CRLF) 72 "=?US-ASCII?Q?a?=\r\n=?US-ASCII?Q?b?=" => "a\r\nb", 73 "a\r\nb" => "a\r\nb", 74 "a\r\n\r\nb" => "a\r\n\r\nb", 75 "a\r\n\r\nb\r\n" => "a\r\n\r\nb\r\n", 76 # multiple multiline (separated by CRLF) 77 "=?US-ASCII?Q?a?=\r\n =?US-ASCII?Q?b?=\r\n=?US-ASCII?Q?c?=" => "ab\r\nc", 78 "a\r\n b\r\nc" => "a b\r\nc", 79 # RT67569 80 "foo =?us-ascii?q?bar?=" => "foo bar", 81 "foo\r\n =?us-ascii?q?bar?=" => "foo bar", 82 "=?us-ascii?q?foo?= bar" => "foo bar", 83 "=?us-ascii?q?foo?=\r\n bar" => "foo bar", 84 "foo bar" => "foo bar", 85 "foo\r\n bar" => "foo bar", 86 "=?us-ascii?q?foo?= =?us-ascii?q?bar?=" => "foobar", 87 "=?us-ascii?q?foo?=\r\n =?us-ascii?q?bar?=" => "foobar", 88 # RT40027 89 "a: b\r\n c" => "a: b c", 90 # RT104422 91 "=?utf-8?Q?pre?= =?utf-8?B?IGZvbw==?=\r\n =?utf-8?Q?bar?=" => "pre foobar", 92 # RT114034 - replace invalid UTF-8 sequence with unicode replacement character 93 "=?utf-8?Q?=f9=80=80=80=80?=" => "���", 94 "=?utf-8?Q?=28=c3=29?=" => "(���)", 95 # decode only known MIME charsets, do not crash on invalid 96 "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", 97 "prefix =?US-ASCII?Q?a_b_c?= =?unknown?Q?d_e_f?= suffix" => "prefix a b c =?unknown?Q?d_e_f?= suffix", 98 "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", 99 # long strings 100 @decode_long_tests, 101 # separators around encoded words 102 "\r\n =?US-ASCII?Q?a?=" => " a", 103 "\r\n (=?US-ASCII?Q?a?=)" => " (a)", 104 "\r\n (=?US-ASCII?Q?a?=)\r\n " => " (a) ", 105 "(=?US-ASCII?Q?a?=)\r\n " => "(a) ", 106 " (=?US-ASCII?Q?a?=) " => " (a) ", 107 "(=?US-ASCII?Q?a?=) " => "(a) ", 108 " (=?US-ASCII?Q?a?=)" => " (a)", 109 "(=?US-ASCII?Q?a?=)(=?US-ASCII?Q?b?=)" => "(a)(b)", 110 "(=?US-ASCII?Q?a?=) (=?US-ASCII?Q?b?=)" => "(a) (b)", 111 "(=?US-ASCII?Q?a?=)\r\n (=?US-ASCII?Q?b?=)" => "(a) (b)", 112 "\r\n (=?US-ASCII?Q?a?=)\r\n (=?US-ASCII?Q?b?=)\r\n " => " (a) (b) ", 113 "\r\n(=?US-ASCII?Q?a?=)\r\n(=?US-ASCII?Q?b?=)" => "\r\n(a)\r\n(b)", 114); 115 116my @decode_default_tests = ( 117 @decode_tests, 118 "=?us-ascii?q?foo bar?=" => "foo bar", 119 "=?us-ascii?q?foo\r\n bar?=" => "foo bar", 120 '=?us-ascii?q?foo=20=3cbar=40baz=2efoo=3e=20bar?=' => 'foo <bar@baz.foo> bar', 121 '"=?us-ascii?q?foo=20=3cbar=40baz=2efoo=3e=20bar?="' => '"foo <bar@baz.foo> bar"', 122 "=?us-ascii?q?foo?==?us-ascii?q?bar?=" => "foobar", 123 "foo=?us-ascii?q?bar?=" => "foobar", 124 "foo =?us-ascii?q?=20?==?us-ascii?q?bar?=" => "foo bar", 125 # Encode::MIME::Header pre 2.83 126 "[=?UTF-8?B?ZsOzcnVt?=]=?UTF-8?B?IHNwcsOhdmE=?=" => "[f��rum] spr��va", 127 "test:=?UTF-8?B?IHNwcsOhdmE=?=" => "test: spr��va", 128 "=?UTF-8?B?dMOpc3Q=?=:=?UTF-8?B?IHNwcsOhdmE=?=", "t��st: spr��va", 129 # multiple base64 parts in one b word 130 "=?us-ascii?b?Zg==Zg==?=" => "ff", 131 # b word with invalid characters 132 "=?us-ascii?b?Zm!!9!v?=" => "foo", 133 # concat consecutive words (with same parameters) and join them into one utf-8 symbol 134 "=?UTF-8?Q?=C3?= =?UTF-8?Q?=A1?=" => "��", 135 # RT114034 - use strict UTF-8 decoder for invalid MIME charsets utf8, UTF8 and utf-8-strict 136 "=?utf8?Q?=C3=A1=f9=80=80=80=80?=" => "�����", 137 "=?UTF8?Q?=C3=A1=f9=80=80=80=80?=" => "�����", 138 "=?utf-8-strict?Q?=C3=A1=f9=80=80=80=80?=" => "�����", 139 # allow non-ASCII characters in q word 140 "=?UTF-8?Q?\x{C3}\x{A1}?=" => "��", 141 # allow missing padding characters '=' in b word 142 "=?UTF-8?B?JQ?=" => "%", 143 "=?UTF-8?B?JQ?= =?UTF-8?B?JQ?=" => "%%", 144 "=?UTF-8?B?YWI?=" => "ab", 145 "=?UTF-8?B?YWI?= =?UTF-8?B?YWI?=" => "abab", 146); 147 148my @decode_strict_tests = ( 149 @decode_tests, 150 "=?us-ascii?q?foo bar?=" => "=?us-ascii?q?foo bar?=", 151 "=?us-ascii?q?foo\r\n bar?=" => "=?us-ascii?q?foo bar?=", 152 '=?us-ascii?q?foo=20=3cbar=40baz=2efoo=3e=20bar?=' => 'foo <bar@baz.foo> bar', 153 '"=?us-ascii?q?foo=20=3cbar=40baz=2efoo=3e=20bar?="' => '"=?us-ascii?q?foo=20=3cbar=40baz=2efoo=3e=20bar?="', 154 # do not decode invalid q words 155 "=?us-ascii?q?foo=?=" => "=?us-ascii?q?foo=?=", 156 "=?us-ascii?q?foo=?= =?us-ascii?q?foo?=" => "=?us-ascii?q?foo=?= foo", 157 # do not decode invalid b words 158 "=?us-ascii?b?----?=" => "=?us-ascii?b?----?=", 159 "=?us-ascii?b?Zm8=-?= =?us-ascii?b?Zm9v?= and =?us-ascii?b?Zg==?=" => "=?us-ascii?b?Zm8=-?= foo and f", 160 "=?us-ascii?b?----?= =?us-ascii?b?Zm9v?= and =?us-ascii?b?Zg==?=" => "=?us-ascii?b?----?= foo and f", 161 # RT114034 - utf8, UTF8 and also utf-8-strict are invalid MIME charset, do not decode it 162 "=?utf8?Q?=C3=A1?=" => "=?utf8?Q?=C3=A1?=", 163 "=?UTF8?Q?=C3=A1?=" => "=?UTF8?Q?=C3=A1?=", 164 "=?utf-8-strict?Q?=C3=A1?=" => "=?utf-8-strict?Q?=C3=A1?=", 165 # do not allow non-ASCII characters in q word 166 "=?UTF-8?Q?\x{C3}\x{A1}?=" => "=?UTF-8?Q?\x{C3}\x{A1}?=", 167 # do not allow missing padding characters '=' in b word 168 "=?UTF-8?B?JQ?=" => "=?UTF-8?B?JQ?=", 169 "=?UTF-8?B?JQ?= =?UTF-8?B?JQ?=" => "=?UTF-8?B?JQ?= =?UTF-8?B?JQ?=", 170 "=?UTF-8?B?YWI?=" => "=?UTF-8?B?YWI?=", 171 "=?UTF-8?B?YWI?= =?UTF-8?B?YWI?=" => "=?UTF-8?B?YWI?= =?UTF-8?B?YWI?=", 172); 173 174my @encode_tests = ( 175 "������ ���" => "=?UTF-8?B?5bCP6aO8IOW8vg==?=", "=?UTF-8?Q?=E5=B0=8F=E9=A3=BC_=E5=BC=BE?=", 176 "������������������������������������������������������������������������������������������������������������������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?=", 177 # double encode 178 "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?=", 179 # pound 1024 180 "\N{POUND SIGN}1024" => "=?UTF-8?B?wqMxMDI0?=", "=?UTF-8?Q?=C2=A31024?=", 181 # latin1 characters 182 "\x{fc}" => "=?UTF-8?B?w7w=?=", "=?UTF-8?Q?=C3=BC?=", 183 # RT42627 184 Encode::decode_utf8("\x{c2}\x{a3}xxxxxxxxxxxxxxxxxxx0") => "=?UTF-8?B?wqN4eHh4eHh4eHh4eHh4eHh4eHh4MA==?=", "=?UTF-8?Q?=C2=A3xxxxxxxxxxxxxxxxxxx0?=", 185 # RT87831 186 "0" => "=?UTF-8?B?MA==?=", "=?UTF-8?Q?0?=", 187 # RT88717 188 "Hey foo\x{2024}bar:whee" => "=?UTF-8?B?SGV5IGZvb+KApGJhcjp3aGVl?=", "=?UTF-8?Q?Hey_foo=E2=80=A4bar=3Awhee?=", 189 # valid q chars 190 "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz !*+-/" => "=?UTF-8?B?MDEyMzQ1Njc4OUFCQ0RFRkdISUpLTE1OT1BRUlNUVVZXWFlaYWJjZGVmZ2hp?=\r\n =?UTF-8?B?amtsbW5vcHFyc3R1dnd4eXogISorLS8=?=", "=?UTF-8?Q?0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_?=\r\n =?UTF-8?Q?!*+-/?=", 191 # invalid q chars 192 "." => "=?UTF-8?B?Lg==?=", "=?UTF-8?Q?=2E?=", 193 "," => "=?UTF-8?B?LA==?=", "=?UTF-8?Q?=2C?=", 194 # long ascii sequence 195 "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?=", 196 # long unicode sequence 197 "����" 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), 198); 199 200sub info { 201 my ($str, $str1, $str2) = @_; 202 substr $str1, 1000, -3, "..." if defined $str1 and length $str1 > 1000; 203 substr $str2, 1000, -3, "..." if defined $str2 and length $str2 > 1000; 204 $str .= ": $str1" if defined $str1; 205 $str .= " => $str2" if defined $str2; 206 $str = Encode::encode_utf8($str); 207 $str =~ s/\r/\\r/gs; 208 $str =~ s/\n/\\n/gs; 209 return $str; 210} 211 212sub check_length { 213 my ($str) = @_; 214 my @lines = split /\r\n /, $str; 215 my @long = grep { length($_) > 75 } @lines; 216 return scalar @long == 0; 217} 218 219my @splice; 220 221@splice = @encode_tests; 222while (my ($d, $b, $q) = splice @splice, 0, 3) { 223 is Encode::encode("MIME-Header", $d) => $b, info("encode default", $d => $b); 224 is Encode::encode("MIME-B", $d) => $b, info("encode base64", $d => $b); 225 is Encode::encode("MIME-Q", $d) => $q, info("encode qp", $d => $q); 226 is Encode::decode("MIME-B", $b) => $d, info("decode base64", $b => $d); 227 is Encode::decode("MIME-Q", $q) => $d, info("decode qp", $b => $d); 228 ok check_length($b), info("correct encoded length base64", $b); 229 ok check_length($q), info("correct encoded length qp", $q); 230} 231 232@splice = @decode_default_tests; 233while (my ($e, $d) = splice @splice, 0, 2) { 234 is Encode::decode("MIME-Header", $e) => $d, info("decode default", $e => $d); 235} 236 237local $Encode::MIME::Header::STRICT_DECODE = 1; 238 239@splice = @decode_strict_tests; 240while (my ($e, $d) = splice @splice, 0, 2) { 241 is Encode::decode("MIME-Header", $e) => $d, info("decode strict", $e => $d); 242} 243 244my $valid_unicode = "��"; 245my $invalid_unicode = "\x{1000000}"; 246{ 247 my $input = $valid_unicode; 248 my $output = Encode::encode("MIME-Header", $input, Encode::FB_QUIET); 249 is $output => Encode::encode("MIME-Header", $valid_unicode), "encode valid with FB_QUIET flag: output string is valid"; 250 is $input => "", "encode valid with FB_QUIET flag: input string is modified and empty"; 251} 252{ 253 my $input = $valid_unicode . $invalid_unicode; 254 my $output = Encode::encode("MIME-Header", $input, Encode::FB_QUIET); 255 is $output => Encode::encode("MIME-Header", $valid_unicode), "encode with FB_QUIET flag: output string stops before first invalid character"; 256 is $input => $invalid_unicode, "encode with FB_QUIET flag: input string is modified and starts with first invalid character"; 257} 258{ 259 my $input = $valid_unicode . $invalid_unicode; 260 my $output = Encode::encode("MIME-Header", $input, Encode::FB_QUIET | Encode::LEAVE_SRC); 261 is $output => Encode::encode("MIME-Header", $valid_unicode), "encode with FB_QUIET and LEAVE_SRC flags: output string stops before first invalid character"; 262 is $input => $valid_unicode . $invalid_unicode, "encode with FB_QUIET and LEAVE_SRC flags: input string is not modified"; 263} 264{ 265 my $input = $valid_unicode . $invalid_unicode; 266 my $output = Encode::encode("MIME-Header", $input, Encode::FB_PERLQQ); 267 is $output => Encode::encode("MIME-Header", $valid_unicode . '\x{1000000}'), "encode with FB_PERLQQ flag: output string contains perl qq representation of invalid character"; 268 is $input => $valid_unicode . $invalid_unicode, "encode with FB_PERLQQ flag: input string is not modified"; 269} 270{ 271 my $input = $valid_unicode; 272 my $output = Encode::encode("MIME-Header", $input, sub { sprintf("!0x%X!", $_[0]) }); 273 is $output => Encode::encode("MIME-Header", $valid_unicode), "encode valid with coderef check: output string is valid"; 274 is $input => $valid_unicode, "encode valid with coderef check: input string is not modified"; 275} 276{ 277 my $input = $valid_unicode . $invalid_unicode; 278 my $output = Encode::encode("MIME-Header", $input, sub { sprintf("!0x%X!", $_[0]) }); 279 is $output => Encode::encode("MIME-Header", $valid_unicode . '!0x1000000!'), "encode with coderef check: output string contains output from coderef"; 280 is $input => $valid_unicode . $invalid_unicode, "encode with coderef check: input string is not modified"; 281} 282 283my $valid_mime = "=?US-ASCII?Q?d=20e=20f?="; 284my $invalid_mime = "=?unknown?Q?a=20b=20c?="; 285my $invalid_mime_unicode = "=?utf-8?Q?=28=c3=29?="; 286{ 287 my $input = $valid_mime; 288 my $output = Encode::decode("MIME-Header", $input, Encode::FB_QUIET); 289 is $output => Encode::decode("MIME-Header", $valid_mime), "decode valid with FB_QUIET flag: output string is valid"; 290 is $input => "", "decode valid with FB_QUIET flag: input string is modified and empty"; 291} 292{ 293 my $input = $valid_mime . " " . $invalid_mime; 294 my $output = Encode::decode("MIME-Header", $input, Encode::FB_QUIET); 295 is $output => Encode::decode("MIME-Header", $valid_mime), "decode with FB_QUIET flag: output string stops before first mime word with unknown charset"; 296 is $input => $invalid_mime, "decode with FB_QUIET flag: input string is modified and starts with first mime word with unknown charset"; 297} 298{ 299 my $input = $valid_mime . " " . $invalid_mime_unicode; 300 my $output = Encode::decode("MIME-Header", $input, Encode::FB_QUIET); 301 is $output => Encode::decode("MIME-Header", $valid_mime), "decode with FB_QUIET flag: output string stops before first mime word with invalid unicode character"; 302 is $input => $invalid_mime_unicode, "decode with FB_QUIET flag: input string is modified and starts with first mime word with invalid unicode character"; 303} 304{ 305 my $input = $valid_mime . " " . $invalid_mime; 306 my $output = Encode::decode("MIME-Header", $input, Encode::FB_QUIET | Encode::LEAVE_SRC); 307 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"; 308 is $input => $valid_mime . " " . $invalid_mime, "decode with FB_QUIET flag: input string is not modified"; 309} 310{ 311 my $input = $valid_mime . " " . $invalid_mime_unicode; 312 my $output = Encode::decode("MIME-Header", $input, Encode::FB_QUIET | Encode::LEAVE_SRC); 313 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"; 314 is $input => $valid_mime . " " . $invalid_mime_unicode, "decode with FB_QUIET flag: input string is not modified"; 315} 316{ 317 my $input = $valid_mime . " " . $invalid_mime; 318 my $output = Encode::decode("MIME-Header", $input, Encode::FB_PERLQQ); 319 is $output => Encode::decode("MIME-Header", $valid_mime) . " " . $invalid_mime, "decode with FB_PERLQQ flag: output string contains unmodified mime word with unknown charset"; 320 is $input => $valid_mime . " " . $invalid_mime, "decode with FB_QUIET flag: input string is not modified"; 321} 322{ 323 my $input = $valid_mime . " " . $invalid_mime_unicode; 324 my $output = Encode::decode("MIME-Header", $input, Encode::FB_PERLQQ); 325 is $output => Encode::decode("MIME-Header", $valid_mime) . '(\xC3)', "decode with FB_PERLQQ flag: output string contains perl qq representation of invalid unicode character"; 326 is $input => $valid_mime . " " . $invalid_mime_unicode, "decode with FB_QUIET flag: input string is not modified"; 327} 328{ 329 my $input = $valid_mime; 330 my $output = Encode::decode("MIME-Header", $input, sub { sprintf("!0x%X!", $_[0]) }); 331 is $output => Encode::decode("MIME-Header", $valid_mime), "decode valid with coderef check: output string is valid"; 332 is $input => $valid_mime, "decode valid with coderef check: input string is not modified"; 333} 334{ 335 my $input = $valid_mime . " " . $invalid_mime; 336 my $output = Encode::decode("MIME-Header", $input, sub { sprintf("!0x%X!", $_[0]) }); 337 is $output => Encode::decode("MIME-Header", $valid_mime) . " " . $invalid_mime, "decode with coderef check: output string contains unmodified mime word with unknown charset"; 338 is $input => $valid_mime . " " . $invalid_mime, "decode with coderef check: input string is not modified"; 339} 340{ 341 my $input = $valid_mime . " " . $invalid_mime_unicode; 342 my $output = Encode::decode("MIME-Header", $input, sub { sprintf("!0x%X!", $_[0]) }); 343 is $output => Encode::decode("MIME-Header", $valid_mime) . '(!0xC3!)', "decode with coderef check: output string contains output from coderef for invalid unicode character"; 344 is $input => $valid_mime . " " . $invalid_mime_unicode, "decode with coderef check: input string is not modified"; 345} 346 347__END__ 348