diff --git a/lib/Encode/CN/HZ.pm b/lib/Encode/CN/HZ.pm index a0dc59d..c1043f6 100644 --- a/lib/Encode/CN/HZ.pm +++ b/lib/Encode/CN/HZ.pm @@ -156,7 +156,7 @@ sub encode($$;$) { } elsif ( $str =~ s/(.)// ) { my $s = $1; - my $tmp = $GB->encode( $s, $chk ); + my $tmp = $GB->encode( $s, $chk || 0 ); last if !defined $tmp; if ( length $tmp == 2 ) { # maybe a valid GB char (XXX) if ($in_ascii) { diff --git a/lib/Encode/JP/JIS7.pm b/lib/Encode/JP/JIS7.pm index a0629a3..7fd07e4 100644 --- a/lib/Encode/JP/JIS7.pm +++ b/lib/Encode/JP/JIS7.pm @@ -52,7 +52,7 @@ sub encode($$;$) { # empty the input string in the stack so perlio is ok $_[1] = '' if $chk; my ( $h2z, $jis0212 ) = @$obj{qw(h2z jis0212)}; - my $octet = Encode::encode( 'euc-jp', $utf8, $chk ); + my $octet = Encode::encode( 'euc-jp', $utf8, $chk || 0 ); $h2z and &Encode::JP::H2Z::h2z( \$octet ); euc_jis( \$octet, $jis0212 ); return $octet; diff --git a/lib/Encode/MIME/Header.pm b/lib/Encode/MIME/Header.pm index e23abff..6ad7d60 100644 --- a/lib/Encode/MIME/Header.pm +++ b/lib/Encode/MIME/Header.pm @@ -128,26 +128,26 @@ sub decode($$;$) { } if ( not defined $enc ) { - Carp::croak qq(Unknown charset "$charset") if not ref $chk and $chk & Encode::DIE_ON_ERR; - Carp::carp qq(Unknown charset "$charset") if not ref $chk and $chk & Encode::WARN_ON_ERR; - $stop = 1 if not ref $chk and $chk & Encode::RETURN_ON_ERR; + Carp::croak qq(Unknown charset "$charset") if not ref $chk and $chk and $chk & Encode::DIE_ON_ERR; + Carp::carp qq(Unknown charset "$charset") if not ref $chk and $chk and $chk & Encode::WARN_ON_ERR; + $stop = 1 if not ref $chk and $chk and $chk & Encode::RETURN_ON_ERR; $output .= ($output =~ /(?:\A|[ \t])$/ ? '' : ' ') . $orig unless $stop; # $orig mime word is separated by whitespace $stop ? $orig : ''; } else { if ( uc($mime_enc) eq 'B' and $obj->{decode_b} ) { my $decoded = _decode_b($enc, $text, $chk); - $stop = 1 if not defined $decoded and not ref $chk and $chk & Encode::RETURN_ON_ERR; + $stop = 1 if not defined $decoded and not ref $chk and $chk and $chk & Encode::RETURN_ON_ERR; $output .= (defined $decoded ? $decoded : $text) unless $stop; $stop ? $orig : ''; } elsif ( uc($mime_enc) eq 'Q' and $obj->{decode_q} ) { my $decoded = _decode_q($enc, $text, $chk); - $stop = 1 if not defined $decoded and not ref $chk and $chk & Encode::RETURN_ON_ERR; + $stop = 1 if not defined $decoded and not ref $chk and $chk and $chk & Encode::RETURN_ON_ERR; $output .= (defined $decoded ? $decoded : $text) unless $stop; $stop ? $orig : ''; } else { - Carp::croak qq(MIME "$mime_enc" unsupported) if not ref $chk and $chk & Encode::DIE_ON_ERR; - Carp::carp qq(MIME "$mime_enc" unsupported) if not ref $chk and $chk & Encode::WARN_ON_ERR; - $stop = 1 if not ref $chk and $chk & Encode::RETURN_ON_ERR; + Carp::croak qq(MIME "$mime_enc" unsupported) if not ref $chk and $chk and $chk & Encode::DIE_ON_ERR; + Carp::carp qq(MIME "$mime_enc" unsupported) if not ref $chk and $chk and $chk & Encode::WARN_ON_ERR; + $stop = 1 if not ref $chk and $chk and $chk & Encode::RETURN_ON_ERR; $output .= ($output =~ /(?:\A|[ \t])$/ ? '' : ' ') . $orig unless $stop; # $orig mime word is separated by whitespace $stop ? $orig : ''; } @@ -198,6 +198,7 @@ sub _decode_q { sub _decode_octets { my ($enc, $octets, $chk) = @_; + $chk = 0 unless defined $chk; $chk &= ~Encode::LEAVE_SRC if not ref $chk and $chk; my $output = $enc->decode($octets, $chk); return undef if not ref $chk and $chk and $octets ne ''; @@ -238,7 +239,9 @@ sub _encode_string { my ($obj, $str, $chk) = @_; my $wordlen = $obj->{bpl} > 76 ? 76 : $obj->{bpl}; my $enc = Encode::find_mime_encoding($obj->{charset}); - my $enc_chk = (not ref $chk and $chk) ? ($chk | Encode::LEAVE_SRC) : $chk; + my $enc_chk = $chk; + $enc_chk = 0 unless defined $enc_chk; + $enc_chk |= Encode::LEAVE_SRC if not ref $enc_chk and $enc_chk; my @result = (); my $octets = ''; while ( length( my $chr = substr($str, 0, 1, '') ) ) { diff --git a/t/decode.t b/t/decode.t index 3995412..45aab70 100644 --- a/t/decode.t +++ b/t/decode.t @@ -4,8 +4,10 @@ use strict; use Encode qw(decode_utf8 FB_CROAK find_encoding decode); use Test::More tests => 17; +use Test::Builder; sub croak_ok(&) { + local $Test::Builder::Level = $Test::Builder::Level + 1; my $code = shift; eval { $code->() }; like $@, qr/does not map/;