/usr/share/perl5/Dancer/Serializer.pm is in libdancer-perl 1.3091+dfsg-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 | package Dancer::Serializer;
# Factory for serializer engines
use strict;
use warnings;
use Dancer::ModuleLoader;
use Dancer::Engine;
use Dancer::Factory::Hook;
use Dancer::Error;
use Dancer::SharedData;
Dancer::Factory::Hook->instance->install_hooks(qw/before_deserializer after_deserializer/);
my $_engine;
sub engine {
$_engine
and return $_engine;
# don't create a new serializer unless it's defined in the config
# (else it's created using json, and that's *not* what we want)
my $serializer_name = Dancer::App->current->setting('serializer');
$serializer_name
and return Dancer::Serializer->init($serializer_name);
return;
}
sub init {
my ($class, $name, $config) = @_;
$name ||= 'JSON';
$_engine = Dancer::Engine->build('serializer' => $name, $config);
return $_engine;
}
# takes a response object and checks whether or not it should be
# serialized.
# returns an error object if the serializer fails
sub process_response {
my ($class, $response) = @_;
my $content = $response->{content};
if (ref($content) && (ref($content) ne 'GLOB')) {
local $@;
eval { $content = engine->serialize($content) };
# the serializer failed, replace the response with an error object
if ($@) {
my $error = Dancer::Error->new(
code => 500,
message => "Serializer ("
. ref($_engine) . ") "
. "failed at serializing "
. $response->{content} . ":\n$@",
);
$response = $error->render;
}
# the serializer succeeded, alter the response object accordingly
else {
$response->header('Content-Type' => engine->content_type);
$response->{content} = $content;
}
}
return $response;
}
# deserialize input params in the request body, if matching the Serializer's
# content-type.
sub process_request {
my ($class, $request) = @_;
Dancer::Factory::Hook->execute_hooks('before_deserializer');
return $request unless engine;
return $request
unless engine->support_content_type($request->content_type);
return $request
unless $request->is_put || $request->is_post || $request->is_patch;
my $old_params = $request->params('body');
# try to deserialize
my $new_params;
eval { $new_params = engine->deserialize($request->body) };
if ($@) {
Dancer::Logger::core "Unable to deserialize request body with "
. engine()
. " : \n$@";
return $request;
}
(keys %$old_params)
? $request->_set_body_params({%$old_params, %$new_params})
: $request->_set_body_params($new_params);
Dancer::Factory::Hook->execute_hooks('after_deserializer');
return $request;
}
1;
__END__
=pod
=head1 NAME
Dancer::Serializer - serializer wrapper for Dancer
=head1 DESCRIPTION
This module is the wrapper that provides support for different
serializers.
=head1 USAGE
=head2 Configuration
The B<serializer> configuration variable tells Dancer which serializer to use
to deserialize request and serialize response.
You change it either in your config.yml file:
serializer: "YAML"
Or in the application code:
# setting JSON as the default serializer
set serializer => 'JSON';
In your routes you can access parameters just like any route.
When in a route you return a Perl data structure, it will be
serialized automatically to the respective serialized engine (for
instance, C<JSON>).
For C<PUT> and C<POST> methods you can access the C<request->body> as
a string, and you can unserialize it, if you really need. If your
content type is recognized by the serializer, C<request->body> will be
unserialized automatically, and it will be available as a standard
parameter.
For instance, if you call
curl -X POST -H 'Content-Type: application/json -d "{'id':'bar'}" /foo
your C<foo> route can do something like:
post "/foo" => {
my $id = param('id'); # gets "bar"
# ...
}
=head1 AUTHORS
This module has been written by Alexis Sukrieh and Franck Cuny.
See the AUTHORS file that comes with this distribution for details.
=head1 LICENSE
This module is free software and is released under the same terms as Perl
itself.
=head1 SEE ALSO
See L<Dancer> for details about the complete framework.
=cut
|