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