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

package Dancer::Serializer::Mutable;
our $AUTHORITY = 'cpan:SUKRIA';
#ABSTRACT: Serialize and deserialize content using the appropriate HTTP header
$Dancer::Serializer::Mutable::VERSION = '1.3514_04'; # TRIAL
$Dancer::Serializer::Mutable::VERSION = '1.351404';
use strict;
use warnings;

use base 'Dancer::Serializer::Abstract', 'Exporter';
use Dancer::SharedData;

our @EXPORT_OK = qw/ template_or_serialize /;

my $serializer = {
    'text/x-yaml'      => 'YAML',
    'text/html'        => 'YAML',
    'text/xml'         => 'XML',
    'text/x-json'      => 'JSON',
    'application/json' => 'JSON',
};

my $loaded_serializer = {};
my $_content_type;

sub template_or_serialize {
    my( $template, $data ) = @_;

    my( $content_type ) = @{ _response_content_types(Dancer::SharedData->request) };

    # TODO the accept value coming from the browser can
    # be quite complex (e.g.,
    # text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
    # ), but that simple heuristic should be good enough
    # for most cases
    if ( $content_type =~ qr#text/html# ) {
        return Dancer::template(@_);
    }

    return $data;
}

sub _request_content_types {
    my $request = shift;

    my $params;

    if ($request) {
        $params = $request->params;
    }

    # we push in @content_types by order of desirability
    # I.e.: we want $content_types[0] more than $content_types[1]
    my @content_types;

    my $method = $request->method;

    if ($method =~ /^(?:POST|PUT|GET|DELETE)$/) {
        push @content_types, $request->{content_type}
            if $request->{content_type};

        push @content_types, $params->{content_type}
            if $params && $params->{content_type};
    }
    push @content_types, 'application/json';

    # remove duplicates
    my %seen;
    return [ grep { not $seen{$_}++ } @content_types ];
}

sub _response_content_types {
    my $request = shift;
    my @content_types;

    push @content_types, $request->{accept}
        if $request->{accept};

    push @content_types, $request->{accept_type}
        if $request->{'accept_type'};

    # Both above could be '*/*' which means it is our choice.

    # Default to the same format as in the request:
    for (@{_request_content_types($request)}) {
        push @content_types, $_;
    }

    # remove duplicates
    my %seen;
    return [ grep { not $seen{$_}++ } @content_types ];
}

sub serialize {
    my ($self, $entity) = @_;
    my $request    = Dancer::SharedData->request;
    my $content_types = _response_content_types($request);
    my $serializer = $self->_load_serializer($request, $content_types);
    return $serializer->serialize($entity);
}

sub deserialize {
    my ($self, $content) = @_;
    my $request    = Dancer::SharedData->request;
    my $content_types = _request_content_types($request);
    my $serializer = $self->_load_serializer($request, $content_types);
    return $serializer->deserialize($content);
}

sub content_type {
    my $self = shift;
    $_content_type;
}

sub support_content_type {
    my ($self, $ct) = @_;
    grep /^$ct$/, keys %$serializer;
}

sub _load_serializer {
    my ($self, $request, $content_types) = @_;

    foreach my $ct (@$content_types) {
        # 'content_type' => 'text/xml; charset=utf-8'
        my $oct = $ct;
        $ct = (split ';', $ct)[0];
        if (exists $serializer->{$ct}) {
            my $module = "Dancer::Serializer::" . $serializer->{$ct};
            if (!exists $loaded_serializer->{$module}) {
                if (Dancer::ModuleLoader->load($module)) {
                    my $serializer_object = $module->new;
                    $loaded_serializer->{$module} = $serializer_object;
                }
            }
            $_content_type = $oct;
            return $loaded_serializer->{$module};
        }
    }
}

1;

__END__