File Coverage

blib/lib/Encode/DoubleEncodedUTF8.pm

Criterion	Covered	Total	%
statement	23	24	95.8
branch	2	4	50.0
condition			n/a
subroutine	6	7	85.7
pod	2	2	100.0
total	33	37	89.1

package Encode::DoubleEncodedUTF8;

use strict;
use base qw( Encode::Encoding );
use Encode 2.12 ();

our $VERSION = '0.05';

__PACKAGE__->Define('utf-8-de');

my $latin1_as_utf8 = "[\xC2\xC3][\x80-\xBF]";

# (Taken from Test::utf8 module)
# A Regexp string to match valid UTF8 bytes
# this info comes from page 78 of "The Unicode Standard 4.0"
# published by the Unicode Consortium
my $valid_utf8_regexp = <<'.' ;
        [\x{00}-\x{7f}]
      | [\x{c2}-\x{df}][\x{80}-\x{bf}]
      |         \x{e0} [\x{a0}-\x{bf}][\x{80}-\x{bf}]
      | [\x{e1}-\x{ec}][\x{80}-\x{bf}][\x{80}-\x{bf}]
      |         \x{ed} [\x{80}-\x{9f}][\x{80}-\x{bf}]
      | [\x{ee}-\x{ef}][\x{80}-\x{bf}][\x{80}-\x{bf}]
      |         \x{f0} [\x{90}-\x{bf}][\x{80}-\x{bf}]
      | [\x{f1}-\x{f3}][\x{80}-\x{bf}][\x{80}-\x{bf}][\x{80}-\x{bf}]
      |         \x{f4} [\x{80}-\x{8f}][\x{80}-\x{bf}][\x{80}-\x{bf}]
.

sub decode {
    my($obj, $buf, $chk) = @_;

    $buf =~ s{((?:$latin1_as_utf8){2,3})}{ _check_utf8_bytes($1) }ego;
    $_[1] = '' if $chk; # this is what in-place edit means

    Encode::decode_utf8($buf);
}

sub _check_utf8_bytes {
    my $bytes = shift;
    my $copy  = $bytes;

    my $possible_utf8 = '';
    while ($copy =~ s/^(.)(.)//) {
        $possible_utf8 .= chr( (ord($1) << 6 & 0xff) | ord($2) )
    }

    $possible_utf8 =~ /$valid_utf8_regexp/xo ? $possible_utf8 : $bytes;
}

sub encode {
    use Carp;
    Carp::croak("utf-8-de doesn't support encode() ... Why do you want to do that?");
}

1;
__END__