File Coverage

blib/lib/Plack/Middleware/FormatOutput.pm
Criterion Covered Total %
statement 65 75 86.6
branch 14 30 46.6
condition 6 11 54.5
subroutine 17 18 94.4
pod 4 4 100.0
total 106 138 76.8


line stmt bran cond sub pod time code
1             package Plack::Middleware::FormatOutput;
2              
3 3     3   100897 use 5.006;
  3         7  
4 3     3   11 use strict;
  3         2  
  3         50  
5 3     3   8 use warnings FATAL => 'all';
  3         11  
  3         90  
6              
7 3     3   384 use parent qw( Plack::Middleware );
  3         213  
  3         12  
8 3     3   10558 use Plack::Util;
  3         3  
  3         49  
9              
10 3     3   1246 use HTTP::Exception '4XX';
  3         10039  
  3         14  
11              
12 3     3   80874 use JSON::XS;
  3         12662  
  3         173  
13 3     3   1389 use YAML::Syck;
  3         4160  
  3         163  
14 3     3   1074 use URL::Encode qw ( url_decode );
  3         9713  
  3         131  
15 3     3   1435 use Encode;
  3         20527  
  3         2012  
16             our $VERSION = '0.09'; # is set automagically with Milla
17              
18             $YAML::Syck::ImplicitUnicode = 1;
19              
20             ### Try load library
21             sub _try_load {
22 2     2   3 my $mod = shift;
23 2 50   2   173 eval("use $mod; 1") ? return 1 : return 0;
  2         420  
  0            
  0            
24             }
25              
26             ### Set default mime types
27             my $MIME_TYPES = {
28             'application/json' => sub { JSON::XS->new->utf8->allow_nonref->encode($_[0]) },
29             'text/yaml' => sub {
30             local $Data::Dumper::Indent=1; local $Data::Dumper::Quotekeys=0; local $Data::Dumper::Terse=1; local $Data::Dumper::Sortkeys=1;
31             Dump($_[0])
32             },
33             'text/plain' => sub {
34             local $Data::Dumper::Indent=1; local $Data::Dumper::Quotekeys=0; local $Data::Dumper::Terse=1; local $Data::Dumper::Sortkeys=1;
35             Dump($_[0])
36             },
37             'text/html' => sub {
38             my ($data, $self, $env) = @_;
39             if ($self->htmlvis){
40             my $ret = $self->htmlvis->html($data, $env); #struct, env
41             return Encode::encode_utf8($ret) if $ret;
42             }
43             return JSON::XS->new->utf8->allow_nonref->encode($data); # Just show content
44             }
45             };
46              
47             sub prepare_app {
48 2     2 1 169676 my $self = shift;
49              
50             ### Check mime types
51 2         3 foreach my $par (keys %{$self->{mime_type}}){
  2         63  
52 1 50       5 delete $self->{mime_type}{$par} if ref $self->{mime_type}{$par} ne 'CODE';
53             }
54              
55             ### Add default MimeTypes
56 2         2 foreach my $par (keys %{$MIME_TYPES}){
  2         8  
57 8 50       29 $self->{mime_type}{$par} = $MIME_TYPES->{$par} unless exists $self->{mime_type}{$par};
58             }
59              
60             ### Add htmlvis
61 2 50       8 if (_try_load('Rest::HtmlVis')){
62 0 0       0 my $params = $self->{htmlvis} if exists $self->{htmlvis};
63 0         0 $self->{htmlvis} = Rest::HtmlVis->new($params);
64             }
65             }
66              
67             sub mime_type {
68 13     13 1 37 return $_[0]->{mime_type};
69             }
70              
71             sub htmlvis {
72 0     0 1 0 return $_[0]->{htmlvis};
73             }
74              
75             sub call {
76 7     7 1 29712 my($self, $env) = @_;
77              
78             ### Run app
79 7         28 my $res = $self->app->($env);
80              
81             ### Get accept from request header
82 7         491 my $accept = _getAccept($self, $env);
83 7 50       14 return $res unless $accept;
84              
85             ### Return handler that manage response
86             return Plack::Util::response_cb($res, sub {
87 7     7   44 my $res = shift;
88 7 100 66     15 if ( !Plack::Util::status_with_no_entity_body( $res->[0] ) && defined $res->[2] ){
    50          
89              
90             ### Set header
91 6 50 33     53 if ($res->[1] && @{$res->[1]}){
  6         16  
92 0         0 Plack::Util::header_set($res->[1], 'Content-Type', $accept);
93             }else{
94 6         11 $res->[1] = ['Content-Type', $accept];
95             }
96              
97             ### Convert data
98 6         11 $res->[2] = [$self->mime_type->{$accept}->($res->[2], $self, $env)];
99             }elsif(! defined $res->[2]){
100 1         15 $res->[2] = []; # backward compatibility
101             }
102             return
103 7         28 });
  7         138  
104             }
105              
106             sub _getAccept {
107 7     7   9 my ($self, $env) = @_;
108              
109             # Get accept from url
110 7         7 my $accept;
111             # We parse this with reqular because we need this as quick as possible
112 7         20 my $query_string = url_decode($env->{QUERY_STRING});
113 7 50       58 if ( $query_string=~/format=([\w\/\+]*)/){
114 0 0       0 if (exists $self->mime_type->{$1}){
115 0         0 $accept = $1;
116             }
117             };
118              
119             # Set accept by http header
120 7 50 33     26 if (!$accept && $env->{HTTP_ACCEPT}){
121 7         20 foreach (split(/,/, $env->{HTTP_ACCEPT})){
122 7 50       14 if ($_ eq '*/*'){
123 0 0       0 $accept = exists $self->mime_type->{'text/html'} ? 'text/html' : undef;
124 0         0 last;
125             }
126 7 100       12 next unless exists $self->mime_type->{$_};
127 6         6 $accept = $_;
128 6         15 last;
129             }
130             }
131              
132 7   100     24 return ($accept||'application/json');
133             }
134              
135             1;
136             __END__