File Coverage

blib/lib/XML/Liberal/Remedy/InvalidEncoding.pm

Criterion	Covered	Total	%
statement	9	22	40.9
branch	0	10	0.0
condition			n/a
subroutine	3	4	75.0
pod	0	1	0.0
total	12	37	32.4

package XML::Liberal::Remedy::InvalidEncoding;
use strict;

use Encode;
use Encode::Guess;

my $RX = qr/^(<\?xml\s+version\s*=\s*["']1\.[01]["']\s+encoding\s*=\s*["'])([^"']+)/;

sub apply {
    my $class = shift;
    my($driver, $error, $xml_ref) = @_;

    return 0 if $error->message !~
        /^(?:(?:i18n |encoding )?error : )?input conversion failed due to input error/;

    my (undef, $encoding) = $$xml_ref =~ $RX;
    unless ($encoding) {
        my @suspects = @{ $driver->guess_encodings || [ qw(euc-jp shift_jis utf-8) ] };
        my $enc = guess_encoding($$xml_ref, @suspects);
        $encoding = $enc->name;
    }

    if ($encoding) {
        Encode::from_to($$xml_ref, $encoding, "UTF-8"), return 1
            if $$xml_ref =~ s/$RX/$1utf-8/;
    }

    Carp::carp("Can't find encoding from XML declaration: ", substr($$xml_ref, 0, 128));
    return 0;
}

1;