The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Clustericious::Plugin::AutodataHandler;

use strict;
use warnings;
use base 'Mojolicious::Plugin';
use Mojo::ByteStream 'b';
use JSON::XS;
use YAML::XS qw/Dump Load/;
use Clustericious::Log;

# ABSTRACT: Handle data types automatically
our $VERSION = '0.9941'; # VERSION


my $default_decode = 'application/x-www-form-urlencoded';
my $default_encode = 'application/json';

my $json_encoder = JSON::XS->new->allow_nonref->allow_blessed->convert_blessed;

my %types =
(
    'application/json' =>
    {
        encode => sub { $json_encoder->encode($_[0]) },
        decode => sub { $json_encoder->decode($_[0]) }
    },
    'text/x-yaml' =>
    {
        encode => sub { Dump($_[0]) },
        decode => sub { Load($_[0]) }
    },
    'application/x-www-form-urlencoded' =>
    {
        decode => sub { my ($data, $c) = @_; $c->req->params->to_hash }
    }
);

my %formats =
(
    'json' => 'application/json',
    'yml'  => 'text/x-yaml',
);

sub register
{
    my ($self, $app, $conf) = @_;

    $default_decode = $conf->{default_decode} if $conf->{default_decode};
    $default_encode = $conf->{default_encode} if $conf->{default_encode};

    $app->renderer->add_handler('autodata' => \&_autodata_renderer);

    $app->plugins->on( parse_autodata => \&_autodata_parse);
    $app->plugins->on( add_autodata_type => \&_autodata_add);

    $app->helper( parse_autodata => \&_autodata_parse );
}

sub _autodata_add
{
    my($plugins, $args) = @_;

    LOGDIE "No extension provided" unless defined $args->{extension};
    my $ext  = $args->{extension};
    my $mime = $args->{mime_type} // 'application/x-' . $ext;

    $formats{$ext} = $mime;
    
    if(defined $args->{encode}) {
        $types{$mime}->{encode} = $args->{encode};
    }
    
    if(defined $args->{decode}) {
        $types{$mime}->{decode} = $args->{decode};
    }
}

sub _find_type
{
    my ($c) = @_;

    my $headers = $c->tx->req->content->headers;

    foreach my $type (map { /^([^;]*)/ } # get only stuff before ;
                      split(',', $headers->header('Accept') || ''),
                      $headers->content_type || '') {
        return $type if $types{$type} and $types{$type}->{encode};
    }

    my $format = $c->stash->{format} // 'json';
    LOGDIE "No type associated with $format" unless $formats{$format};

    return $formats{$format};
}

sub _autodata_renderer
{
    my ($r, $c, $output, $data) = @_;

    my $type = _find_type($c);
    LOGDIE "no encoder for $type" unless $types{$type}{encode};
    $$output = $types{$type}->{encode}->($c->stash("autodata"), $c);

    $c->tx->res->headers->content_type($type);

    return 1;
}

sub _autodata_parse
{
    my ($c) = @_;

    my $content_type = $c->req->headers->content_type || $default_decode;
    if ($content_type =~ /^([^;]+);/) {
        # strip charset
        $content_type = $1;
    }
    my $entry = $types{$content_type} || $types{$default_decode};

    $c->stash->{autodata} = $entry->{decode}->($c->req->body, $c);
    return $c->stash->{autodata};
}

1;

__END__
=pod

=head1 NAME

Clustericious::Plugin::AutodataHandler - Handle data types automatically

=head1 VERSION

version 0.9941

=head1 SYNOPSIS

 package YourApp::Routes;
 
 use Clustericious::RouteBuilder;
 
 get '/some/route' => sub {
   my $c = shift;
   $c->{autodata} = { x => 1, y => 'hello, z => [1,2,3] };
 };

=head1 DESCRIPTION

Adds a renderer that automatically serializes that "autodata" in the
stash into a format based on HTTP Accept and Content-Type headers.
Also adds a helper called 'parse_autodata' that handles incoming data by
Content-Type.

Supports application/json, text/x-yaml and
application/x-www-form-urlencoded (in-bound only).

When parse_autodata is called from within a route like this:

 $self->parse_autodata;

POST data is parsed according to the type in the 'Content-Type'
header with the data left in stash->{autodata}.  It is also
returned by the above call.

If a route leaves data in stash->{autodata}, it is rendered by this
handler, which chooses the type with the first acceptable type listed
in the Accept header, the Content-Type header, or the default.  (By
default, the default is application/json, but you can override that
too).

=head1 AUTHOR

original author: Brian Duggan

current maintainer: Graham Ollis <plicease@cpan.org>

contributors:

Curt Tilmes

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by NASA GSFC.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut