File Coverage

blib/lib/Data/Decode/Encode/Guess.pm

Criterion	Covered	Total	%
statement	26	26	100.0
branch	2	2	100.0
condition	2	5	40.0
subroutine	7	7	100.0
pod	2	2	100.0
total	39	42	92.8

# $Id: /mirror/perl/Data-Decode/trunk/lib/Data/Decode/Encode/Guess.pm 4834 2007-11-03T09:22:42.139028Z daisuke  $
#
# Copyright (c) 2007 Daisuke Maki
# All rights reserved.

package Data::Decode::Encode::Guess;
use strict;
use warnings;
use base qw(Class::Accessor::Fast);
use Encode();
use Encode::Guess();

__PACKAGE__->mk_accessors($_) for qw(encodings);

sub new
{
    my $class = shift;
    my %args  = @_;
    $args{encodings} ||= [];
    $class->SUPER::new(\%args);
}

sub decode
{
    my ($self, $decoder, $string, $hints) = @_;

    local $Encode::Guess::NoUTFAutoGuess = 1;
    my $guess = Encode::Guess::guess_encoding(
        $string,
        @{ $self->encodings }
    );

    if (! ref $guess) {
        Data::Decode::Exception::Deferred->throw($guess);
    }

    return eval { $guess->decode( $string ) } ||
        Data::Decode::Exception::Deferred->throw("Failed to decode string from " . $guess->name . ": $@")
    ;
}

1;

__END__