HTTP::Body::JSON

JSON.pm

package HTTP::Body::JSON;
use strict;
use warnings;
use parent qw(HTTP::Body);
use JSON::XS;
use HTTP::Body;
use Encode qw(encode_utf8);

# based on tokuhirom-san's code

$HTTP::Body::TYPES->{'application/json'} = __PACKAGE__;

sub spin {
    my $self = shift;

    return unless $self->length == $self->content_length;

    my $dat = JSON::XS::decode_json($self->{buffer});
    while (my ($k, $v) = each %$dat) {
        $self->param(_encode($k), _encode($v));
    }

    $self->{buffer} = '';
    $self->{state} = 'done';
}

sub _encode {
    my ($data) = @_;
    if (ref $data eq "ARRAY") {
        my @result;
        for my $d (@$data) {
            push @result, _encode($d);
        }

        return \@result;
    }
    elsif (ref $data eq "HASH") {
        my %result;
        while (my ($k, $v) = each %$data) {
            $result{_encode($k)} = _encode($v);
        }

        return \%result;
    }

    return encode_utf8($data)
}

1;