File Coverage

blib/lib/Plack/Middleware/ParseContent.pm

Criterion	Covered	Total	%
statement	47	72	65.2
branch	8	28	28.5
condition	8	21	38.1
subroutine	10	10	100.0
pod	2	2	100.0
total	75	133	56.3

package Plack::Middleware::ParseContent;

use 5.006;
use strict;
use warnings FATAL => 'all';

our $VERSION = '0.09'; # Set automatically by milla

use parent qw( Plack::Middleware );

use Plack::Request;

use HTTP::Exception '4XX';

use JSON::XS;
use YAML::Syck;
my $Mime_types;

$YAML::Syck::ImplicitUnicode = 1;

$Mime_types = {
    'application/json'   => sub { &decode_json($_[1]) },
    'text/yaml'          => sub { &YAML::Syck::Load($_[1]) },
    'text/plain'         => sub { $_[1] },
    'application/x-www-form-urlencoded' => sub {

	   	my ($env, $content, $req) = @_;

		### Get data for form or from body
		my $alldata = $req->body_parameters;
		return $alldata;
    }
};

sub prepare_app {
    my $self = shift;

    # Add new mime types to env
	foreach my $par (keys %$self){
		next unless ref $self->{$par} eq 'CODE'; # just add mime types that are reference to sub
		$Mime_types->{$par} = $self->{$par};
	}
}

sub call {
	my($self, $env) = @_;

	### Get method
	my $method = $env->{REQUEST_METHOD};

	### Get dat from env
	my $data;

	my $req = Plack::Request->new($env);
	if ($method eq 'POST' or $method eq 'PUT') {
		my $contentType = $req->content_type;
		my $content = $req->content();

		### Parse data by content-type
		my $acceptedMimeType;
		if ($content && $contentType){
			($acceptedMimeType) = grep( exists $Mime_types->{$_} , split(/;/, $contentType, 2));
		}else{
			$acceptedMimeType = 'text/plain'; # set default mime type
		}

		### Parsed data
		my $parsed;
		if ($content && $acceptedMimeType){
			my $resp = eval {$Mime_types->{$acceptedMimeType}->($env, $content, $req)};
			HTTP::Exception::400->throw(status_message => "Parser error: $@") if $@;

			# Parse encode type from parameters
			if ($resp && (ref $resp) =~ /^HASH/i && exists $resp->{enctype}){
				my $contentType = delete $resp->{enctype};
				my $format =  delete $resp->{format};

				if (exists $resp->{DATA}){
					$content = delete $resp->{DATA};
					$data = eval {$Mime_types->{$contentType}->($env, $content, $req)};
					HTTP::Exception::400->throw(status_message => "Parser error: $@") if $@;
				}
				foreach my $param ( keys %{$resp} ){
					if ( (ref $data) =~ /^HASH/i && $param !~ /^query\./){
						$data->{$param} = $resp->mixed->{$param};
						delete $resp->{$param};
					}else{
						my $query_value='';
						my $outParam = $param;
						$outParam =~ s/^query\.//;
						if(ref $resp->mixed->{$param} eq "ARRAY"){
							$query_value = "$outParam=" . join "\&$outParam=",@{$resp->mixed->{$param}};
						}else{
							$query_value = "$outParam=" . $resp->mixed->{$param};
						}
						$data->{$param} = $resp->mixed->{$param};
						$env->{QUERY_STRING} .= ( $env->{QUERY_STRING} eq ''?'':'&' ) . $query_value;
						delete $resp->{$param};
					}
				}
			}else{
				$data = $resp;
			}
			if ($data && (ref $data eq 'Hash::MultiValue')){
				$data = $data->mixed;
			}
		}

	}elsif ($method eq 'GET'){
		$data = $req->query_parameters;
	}

	$env->{'parsecontent.data'} = $data if $data;
	return $self->app->($env);
}

1;
__END__