File Coverage

blib/lib/Plack/Middleware/ParseContent.pm
Criterion Covered Total %
statement 46 69 66.6
branch 7 26 26.9
condition 7 18 38.8
subroutine 10 10 100.0
pod 2 2 100.0
total 72 125 57.6


line stmt bran cond sub pod time code
1             package Plack::Middleware::ParseContent;
2              
3 2     2   56135 use 5.006;
  2         4  
4 2     2   6 use strict;
  2         2  
  2         35  
5 2     2   5 use warnings FATAL => 'all';
  2         8  
  2         86  
6              
7             our $VERSION = '0.07'; # Set automatically by milla
8              
9 2     2   395 use parent qw( Plack::Middleware );
  2         247  
  2         7  
10              
11 2     2   11449 use Plack::Request;
  2         69388  
  2         51  
12              
13 2     2   833 use HTTP::Exception '4XX';
  2         6481  
  2         10  
14              
15 2     2   53682 use JSON::XS;
  2         7503  
  2         98  
16 2     2   793 use YAML::Syck;
  2         2520  
  2         1024  
17             my $Mime_types;
18              
19             $YAML::Syck::ImplicitUnicode = 1;
20              
21             $Mime_types = {
22             'application/json' => sub { &decode_json($_[1]) },
23             'text/yaml' => sub { &YAML::Syck::Load($_[1]) },
24             'text/plain' => sub { $_[1] },
25             'application/x-www-form-urlencoded' => sub {
26              
27             my ($env, $content, $req) = @_;
28              
29             ### Get data for form or from body
30             my $alldata = $req->body_parameters;
31             return $alldata;
32             }
33             };
34              
35             sub prepare_app {
36 1     1 1 89609 my $self = shift;
37              
38             # Add new mime types to env
39 1         28 foreach my $par (keys %$self){
40 2 50       6 next unless ref $self->{$par} eq 'CODE'; # just add mime types that are reference to sub
41 2         5 $Mime_types->{$par} = $self->{$par};
42             }
43             }
44              
45             sub call {
46 4     4 1 16418 my($self, $env) = @_;
47              
48             ### Get method
49 4         5 my $method = $env->{REQUEST_METHOD};
50              
51             ### Get dat from env
52 4         4 my $data;
53              
54 4         20 my $req = Plack::Request->new($env);
55 4 50 33     33 if ($method eq 'POST' or $method eq 'PUT') {
    0          
56 4         8 my $contentType = $req->content_type;
57 4         21 my $content = $req->content();
58              
59             ### Parse data by content-type
60 4         2536 my $acceptedMimeType;
61 4 50 33     30 if ($content && $contentType){
62 4         18 ($acceptedMimeType) = grep( exists $Mime_types->{$_} , split(/;/, $contentType, 2));
63             }else{
64 0         0 $acceptedMimeType = 'text/plain'; # set default mime type
65             }
66              
67             ### Parsed data
68 4         4 my $parsed;
69 4 50 33     18 if ($content && $acceptedMimeType){
70 4         5 my $resp = eval {$Mime_types->{$acceptedMimeType}->($env, $content, $req)};
  4         9  
71 4 50       110 HTTP::Exception::400->throw(status_message => "Parser error: $@") if $@;
72              
73             # Parse encode type from parameters
74 4 50 66     23 if ($resp && ref $resp eq 'HASH' && exists $resp->{enctype}){
      66        
75 0         0 my $contentType = delete $resp->{enctype};
76 0         0 my $format = delete $resp->{format};
77              
78 0 0       0 if (exists $resp->{DATA}){
79 0         0 $content = delete $resp->{DATA};
80 0         0 $data = eval {$Mime_types->{$contentType}->($env, $content, $req)};
  0         0  
81 0 0       0 HTTP::Exception::400->throw(status_message => "Parser error: $@") if $@;
82             }
83 0         0 foreach my $param ( keys %{$resp} ){
  0         0  
84 0 0 0     0 if (ref $data eq "HASH" and $param !~ /^query\./){
85 0         0 $data->{$param} = $resp->mixed->{$param};
86 0         0 delete $resp->{$param};
87             }else{
88 0         0 my $query_value='';
89 0         0 my $outParam = $param;
90 0         0 $outParam =~ s/^query\.//;
91 0 0       0 if(ref $resp->mixed->{$param} eq "ARRAY"){
92 0         0 $query_value = "$outParam=" . join "\&$outParam=",@{$resp->mixed->{$param}};
  0         0  
93             }else{
94 0         0 $query_value = "$outParam=" . $resp->mixed->{$param};
95             }
96 0 0       0 $env->{QUERY_STRING} .= ( $env->{QUERY_STRING} eq ''?'':'&' ) . $query_value;
97 0         0 delete $resp->{$param};
98             }
99              
100             }
101             }else{
102 4         9 $data = $resp;
103             }
104              
105             }
106              
107             }elsif ($method eq 'GET'){
108 0         0 $data = $req->query_parameters;
109             }
110              
111 4 50       13 $env->{'parsecontent.data'} = $data if $data;
112 4         14 return $self->app->($env);
113             }
114              
115             1;
116             __END__