line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Dancer::Serializer::Mutable; |
2
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:SUKRIA'; |
3
|
|
|
|
|
|
|
#ABSTRACT: Serialize and deserialize content using the appropriate HTTP header |
4
|
|
|
|
|
|
|
$Dancer::Serializer::Mutable::VERSION = '1.3521'; |
5
|
4
|
|
|
4
|
|
1974
|
use strict; |
|
4
|
|
|
|
|
14
|
|
|
4
|
|
|
|
|
125
|
|
6
|
4
|
|
|
4
|
|
49
|
use warnings; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
118
|
|
7
|
|
|
|
|
|
|
|
8
|
4
|
|
|
4
|
|
25
|
use base 'Dancer::Serializer::Abstract', 'Exporter'; |
|
4
|
|
|
|
|
10
|
|
|
4
|
|
|
|
|
564
|
|
9
|
4
|
|
|
4
|
|
32
|
use Dancer::SharedData; |
|
4
|
|
|
|
|
10
|
|
|
4
|
|
|
|
|
3092
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our @EXPORT_OK = qw/ template_or_serialize /; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
my $serializer = { |
14
|
|
|
|
|
|
|
'text/x-yaml' => 'YAML', |
15
|
|
|
|
|
|
|
'text/html' => 'YAML', |
16
|
|
|
|
|
|
|
'text/xml' => 'XML', |
17
|
|
|
|
|
|
|
'text/x-json' => 'JSON', |
18
|
|
|
|
|
|
|
'application/json' => 'JSON', |
19
|
|
|
|
|
|
|
}; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
my $loaded_serializer = {}; |
22
|
|
|
|
|
|
|
my $_content_type; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub template_or_serialize { |
25
|
2
|
|
|
2
|
1
|
15
|
my( $template, $data ) = @_; |
26
|
|
|
|
|
|
|
|
27
|
2
|
|
|
|
|
5
|
my( $content_type ) = @{ _response_content_types(Dancer::SharedData->request) }; |
|
2
|
|
|
|
|
8
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# TODO the accept value coming from the browser can |
30
|
|
|
|
|
|
|
# be quite complex (e.g., |
31
|
|
|
|
|
|
|
# text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8 |
32
|
|
|
|
|
|
|
# ), but that simple heuristic should be good enough |
33
|
|
|
|
|
|
|
# for most cases |
34
|
2
|
100
|
|
|
|
19
|
if ( $content_type =~ qr#text/html# ) { |
35
|
1
|
|
|
|
|
7
|
return Dancer::template(@_); |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
1
|
|
|
|
|
7
|
return $data; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub _request_content_types { |
42
|
17
|
|
|
17
|
|
43
|
my $request = shift; |
43
|
|
|
|
|
|
|
|
44
|
17
|
|
|
|
|
20
|
my $params; |
45
|
|
|
|
|
|
|
|
46
|
17
|
50
|
|
|
|
35
|
if ($request) { |
47
|
17
|
|
|
|
|
39
|
$params = $request->params; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# we push in @content_types by order of desirability |
51
|
|
|
|
|
|
|
# I.e.: we want $content_types[0] more than $content_types[1] |
52
|
17
|
|
|
|
|
35
|
my @content_types; |
53
|
|
|
|
|
|
|
|
54
|
17
|
|
|
|
|
49
|
my $method = $request->method; |
55
|
|
|
|
|
|
|
|
56
|
17
|
50
|
|
|
|
98
|
if ($method =~ /^(?:POST|PUT|GET|DELETE)$/) { |
57
|
|
|
|
|
|
|
push @content_types, $request->{content_type} |
58
|
17
|
100
|
|
|
|
47
|
if $request->{content_type}; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
push @content_types, $params->{content_type} |
61
|
17
|
100
|
66
|
|
|
68
|
if $params && $params->{content_type}; |
62
|
|
|
|
|
|
|
} |
63
|
17
|
|
|
|
|
29
|
push @content_types, 'application/json'; |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# remove duplicates |
66
|
17
|
|
|
|
|
21
|
my %seen; |
67
|
17
|
|
|
|
|
24
|
return [ grep { not $seen{$_}++ } @content_types ]; |
|
26
|
|
|
|
|
118
|
|
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub _response_content_types { |
71
|
11
|
|
|
11
|
|
1030
|
my $request = shift; |
72
|
11
|
|
|
|
|
17
|
my @content_types; |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
push @content_types, $request->{accept} |
75
|
11
|
100
|
|
|
|
39
|
if $request->{accept}; |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
push @content_types, $request->{accept_type} |
78
|
11
|
100
|
|
|
|
26
|
if $request->{'accept_type'}; |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# Both above could be '*/*' which means it is our choice. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
# Default to the same format as in the request: |
83
|
11
|
|
|
|
|
12
|
for (@{_request_content_types($request)}) { |
|
11
|
|
|
|
|
30
|
|
84
|
15
|
|
|
|
|
26
|
push @content_types, $_; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# remove duplicates |
88
|
11
|
|
|
|
|
21
|
my %seen; |
89
|
11
|
|
|
|
|
17
|
return [ grep { not $seen{$_}++ } @content_types ]; |
|
20
|
|
|
|
|
70
|
|
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub serialize { |
93
|
6
|
|
|
6
|
1
|
10
|
my ($self, $entity) = @_; |
94
|
6
|
|
|
|
|
15
|
my $request = Dancer::SharedData->request; |
95
|
6
|
|
|
|
|
14
|
my $content_types = _response_content_types($request); |
96
|
6
|
|
|
|
|
20
|
my $serializer = $self->_load_serializer($request, $content_types); |
97
|
6
|
|
|
|
|
18
|
return $serializer->serialize($entity); |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
sub deserialize { |
101
|
4
|
|
|
4
|
1
|
7
|
my ($self, $content) = @_; |
102
|
4
|
|
|
|
|
12
|
my $request = Dancer::SharedData->request; |
103
|
4
|
|
|
|
|
8
|
my $content_types = _request_content_types($request); |
104
|
4
|
|
|
|
|
10
|
my $serializer = $self->_load_serializer($request, $content_types); |
105
|
4
|
|
|
|
|
13
|
return $serializer->deserialize($content); |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub content_type { |
109
|
7
|
|
|
7
|
1
|
1938
|
my $self = shift; |
110
|
7
|
|
|
|
|
29
|
$_content_type; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub support_content_type { |
114
|
10
|
|
|
10
|
0
|
27
|
my ($self, $ct) = @_; |
115
|
10
|
|
|
|
|
187
|
grep /^$ct$/, keys %$serializer; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub _load_serializer { |
119
|
10
|
|
|
10
|
|
22
|
my ($self, $request, $content_types) = @_; |
120
|
|
|
|
|
|
|
|
121
|
10
|
|
|
|
|
19
|
foreach my $ct (@$content_types) { |
122
|
|
|
|
|
|
|
# 'content_type' => 'text/xml; charset=utf-8' |
123
|
10
|
|
|
|
|
21
|
my $oct = $ct; |
124
|
10
|
|
|
|
|
40
|
$ct = (split ';', $ct)[0]; |
125
|
10
|
50
|
|
|
|
25
|
if (exists $serializer->{$ct}) { |
126
|
10
|
|
|
|
|
24
|
my $module = "Dancer::Serializer::" . $serializer->{$ct}; |
127
|
10
|
100
|
|
|
|
23
|
if (!exists $loaded_serializer->{$module}) { |
128
|
4
|
50
|
|
|
|
20
|
if (Dancer::ModuleLoader->load($module)) { |
129
|
4
|
|
|
|
|
49
|
my $serializer_object = $module->new; |
130
|
4
|
|
|
|
|
11
|
$loaded_serializer->{$module} = $serializer_object; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
} |
133
|
10
|
|
|
|
|
13
|
$_content_type = $oct; |
134
|
10
|
|
|
|
|
24
|
return $loaded_serializer->{$module}; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
1; |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
__END__ |