File Coverage

blib/lib/Data/Decode/Encode/HTTP/Response.pm

Criterion	Covered	Total	%
statement	21	44	47.7
branch	0	8	0.0
condition	0	5	0.0
subroutine	7	9	77.7
pod	2	2	100.0
total	30	68	44.1

# $Id: /mirror/perl/Data-Decode/trunk/lib/Data/Decode/Encode/HTTP/Response.pm 8763 2007-11-06T09:42:32.814221Z daisuke  $
#
# Copyright (c) 2007 Daisuke Maki
# All rights reserved.

package Data::Decode::Encode::HTTP::Response;
use strict;
use warnings;
use base qw(Class::Accessor::Fast);
use Data::Decode::Exception;
use Encode();
use Data::Decode::Util qw(try_decode pick_encoding);
use HTTP::Response::Encoding;

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

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

    if (! $hints->{response} || ! eval { $hints->{response}->isa('HTTP::Response') }) {
        Data::Decode::Exception::Deferred->throw;
    }
    my $res = $hints->{response};

    my $decoded;
    { # Attempt to decode from header information
        my $encoding = pick_encoding(
            $res->encoding,
            ( ($res->header('Content-Type') || '') =~ /charset=([\w\-]+)/g),
        );
        $decoded = try_decode($encoding, $string);
        return $decoded if $decoded;
    }

    { # Attempt to decode from meta information
        my $p = $self->parser();
        my $encoding = pick_encoding(
            $p->extract_encodings( $res->content )
        );

        $decoded = try_decode($encoding, $string);
        return $decoded if $decoded;
    }

    Data::Decode::Exception::Deferred->throw;
}

sub parser
{
    my $self = shift;
    my $parser = $self->_parser();
    if (! $parser) {
        require Data::Decode::Encode::HTTP::Response::Parser;
        $parser = Data::Decode::Encode::HTTP::Response::Parser->new();
        $self->_parser($parser);
    }
    return $parser;
}

1;

__END__