File Coverage

blib/lib/Web/Machine/Util/BodyEncoding.pm

Criterion	Covered	Total	%
statement	42	42	100.0
branch	13	14	92.8
condition	7	10	70.0
subroutine	13	13	100.0
pod	2	2	100.0
total	77	81	95.0

package Web::Machine::Util::BodyEncoding;
BEGIN {
  $Web::Machine::Util::BodyEncoding::AUTHORITY = 'cpan:STEVAN';
}
# ABSTRACT: Module to handle body encoding
$Web::Machine::Util::BodyEncoding::VERSION = '0.15';
use strict;
use warnings;

use Scalar::Util qw/ weaken isweak /;
use Encode ();
use Web::Machine::Util qw[ first pair_key pair_value ];

use Sub::Exporter -setup => {
    exports => [qw[
        encode_body_if_set
        encode_body
    ]]
};

sub encode_body_if_set {
    my ($resource, $response) = @_;
    encode_body( $resource, $response ) if $response->body;
}

sub encode_body {
    my ($resource, $response) = @_;

    my $metadata        = $resource->request->env->{'web.machine.context'};
    my $chosen_encoding = $metadata->{'Content-Encoding'};
    my $encoder         = $resource->encodings_provided->{ $chosen_encoding };

    my $chosen_charset = $metadata->{'Charset'};
    my $charsetter;
    if ( $chosen_charset && $resource->charsets_provided ) {
        my $match =             first {
                my $name = $_ && ref $_ ? pair_key($_) : $_;
                $name && $name eq $chosen_charset;
            }
            @{ $resource->charsets_provided };

        $charsetter
            = ref $match
            ? pair_value($match)
            : sub { Encode::encode( $match, $_[1] ) };
    }

    $charsetter ||= sub { $_[1] };

    push @{ $resource->request->env->{'web.machine.content_filters'} ||= [] },
        sub {
            my $chunk = shift;
            weaken $resource unless isweak $resource;
            return unless defined $chunk;
            return $resource->$encoder($resource->$charsetter($chunk));
        };
}


1;

__END__