File Coverage

blib/lib/Dancer/Serializer/Mutable.pm
Criterion Covered Total %
statement 67 67 100.0
branch 16 20 80.0
condition 2 3 66.6
subroutine 12 12 100.0
pod 4 5 80.0
total 101 107 94.3


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.3520';
5 4     4   2241 use strict;
  4         12  
  4         132  
6 4     4   22 use warnings;
  4         8  
  4         122  
7              
8 4     4   24 use base 'Dancer::Serializer::Abstract', 'Exporter';
  4         10  
  4         644  
9 4     4   33 use Dancer::SharedData;
  4         12  
  4         3459  
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         6  
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       15 if ( $content_type =~ qr#text/html# ) {
35 1         9 return Dancer::template(@_);
36             }
37              
38 1         6 return $data;
39             }
40              
41             sub _request_content_types {
42 17     17   54 my $request = shift;
43              
44 17         26 my $params;
45              
46 17 50       36 if ($request) {
47 17         49 $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         37 my @content_types;
53              
54 17         56 my $method = $request->method;
55              
56 17 50       111 if ($method =~ /^(?:POST|PUT|GET|DELETE)$/) {
57             push @content_types, $request->{content_type}
58 17 100       48 if $request->{content_type};
59              
60             push @content_types, $params->{content_type}
61 17 100 66     75 if $params && $params->{content_type};
62             }
63 17         35 push @content_types, 'application/json';
64              
65             # remove duplicates
66 17         23 my %seen;
67 17         35 return [ grep { not $seen{$_}++ } @content_types ];
  26         156  
68             }
69              
70             sub _response_content_types {
71 11     11   1514 my $request = shift;
72 11         34 my @content_types;
73              
74             push @content_types, $request->{accept}
75 11 100       47 if $request->{accept};
76              
77             push @content_types, $request->{accept_type}
78 11 100       32 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         17 for (@{_request_content_types($request)}) {
  11         25  
84 15         35 push @content_types, $_;
85             }
86              
87             # remove duplicates
88 11         22 my %seen;
89 11         20 return [ grep { not $seen{$_}++ } @content_types ];
  20         70  
90             }
91              
92             sub serialize {
93 6     6 1 14 my ($self, $entity) = @_;
94 6         18 my $request = Dancer::SharedData->request;
95 6         14 my $content_types = _response_content_types($request);
96 6         19 my $serializer = $self->_load_serializer($request, $content_types);
97 6         22 return $serializer->serialize($entity);
98             }
99              
100             sub deserialize {
101 4     4 1 10 my ($self, $content) = @_;
102 4         15 my $request = Dancer::SharedData->request;
103 4         10 my $content_types = _request_content_types($request);
104 4         11 my $serializer = $self->_load_serializer($request, $content_types);
105 4         17 return $serializer->deserialize($content);
106             }
107              
108             sub content_type {
109 7     7 1 2021 my $self = shift;
110 7         33 $_content_type;
111             }
112              
113             sub support_content_type {
114 10     10 0 26 my ($self, $ct) = @_;
115 10         247 grep /^$ct$/, keys %$serializer;
116             }
117              
118             sub _load_serializer {
119 10     10   33 my ($self, $request, $content_types) = @_;
120              
121 10         25 foreach my $ct (@$content_types) {
122             # 'content_type' => 'text/xml; charset=utf-8'
123 10         13 my $oct = $ct;
124 10         41 $ct = (split ';', $ct)[0];
125 10 50       28 if (exists $serializer->{$ct}) {
126 10         30 my $module = "Dancer::Serializer::" . $serializer->{$ct};
127 10 100       30 if (!exists $loaded_serializer->{$module}) {
128 4 50       30 if (Dancer::ModuleLoader->load($module)) {
129 4         45 my $serializer_object = $module->new;
130 4         20 $loaded_serializer->{$module} = $serializer_object;
131             }
132             }
133 10         17 $_content_type = $oct;
134 10         29 return $loaded_serializer->{$module};
135             }
136             }
137             }
138              
139             1;
140              
141             __END__