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__ |