libdancer-perl 1.3095+dfsg-1 / usr / share / perl5 / Dancer / Serializer.pm

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;

    # Content-Type may contain additional parameters
    # (http://www.w3.org/Protocols/rfc2616/rfc2616-sec3.html#sec3.7)
    # which should be safe to ignore at this level.
    # So accept either e.g. text/xml or text/xml; charset=utf-8
    my $content_type = $request->content_type;
    $content_type =~ s/ \s* ; .+ $ //x;
    return $request unless engine->support_content_type($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