1use strict;
2use warnings;
3
4use Test::More tests => 5
5;
6use Dancer2::Serializer::Mutable;
7use Plack::Test;
8use HTTP::Request::Common;
9use Encode;
10use JSON::MaybeXS;
11use YAML;
12use Ref::Util qw<is_coderef>;
13
14{
15    package MyApp;
16    use Dancer2;
17    use Ref::Util qw<is_hashref>;
18
19    set serializer => 'Mutable';
20
21    get '/serialize'     => sub { +{ bar => 'baz' } };
22    post '/deserialize'  => sub {
23        return request->data &&
24               is_hashref( request->data ) &&
25               request->data->{bar} ? { bar => request->data->{bar} } : { ret => '?' };
26    };
27}
28
29my $test = Plack::Test->create( MyApp->to_app );
30
31subtest "serializer returns to default state" => sub {
32
33    my $res = $test->request( GET '/serialize' );
34    is(
35        $res->headers->content_type,
36        'application/json',
37        "Default content-type header",
38    );
39
40    $res = $test->request( GET '/serialize', 'Accept' => 'text/x-data-dumper' );
41    is(
42        $res->headers->content_type,
43        'text/x-data-dumper',
44        "Correct content-type header",
45    );
46    $res = $test->request( GET '/serialize' );
47    is(
48        $res->headers->content_type,
49        'application/json',
50        "Correct default content-type header after a request that used another",
51    );
52};
53
54
55
56# Configure test content-type cases
57my $d = {
58    yaml    => {
59            types       => [ qw(text/x-yaml text/html) ],
60            value       => encode('UTF-8', YAML::Dump({ bar => 'baz' })),
61            last_val    => "---bar:baz",
62        },
63    dumper  => {
64            types       => [ qw(text/x-data-dumper) ],
65            value       => Data::Dumper::Dumper({ bar => 'baz' }),
66            last_val    => "\$VAR1={'bar'=>'baz'};",
67        },
68    json    => {
69            types       => [ qw(text/x-json application/json) ],
70            value       => JSON::MaybeXS::encode_json({ bar => 'baz' }),
71            last_val    => '{"bar":"baz"}',
72        },
73    default => {
74            types       => [ '*/*', '' ],
75            value       => JSON::MaybeXS::encode_json({ bar => 'baz' }),
76            last_val    => '{"bar":"baz"}',
77            return_content_type => 'application/json',
78        },
79};
80
81for my $format (keys %$d) {
82
83    subtest "Format: $format" => sub {
84        my $s = $d->{$format};
85
86        # Response with implicit call to the serializer
87        for my $content_type ( @{ $s->{types} } ) {
88
89            for my $ct (qw/Content-Type Accept/) {
90
91                # Test getting the value serialized in the correct format
92                my $res = $test->request( GET '/serialize', $ct => $content_type );
93
94                is( $res->code, 200, "[/$format] Correct status" );
95                is( $res->content, $s->{value}, "[/$format] Correct content" );
96                is(
97                    $res->headers->content_type,
98                    $s->{return_content_type} || $content_type,
99                    "[/$format] Correct content-type headers",
100                );
101            }
102
103            # Test sending the value serialized in the correct format
104            # needs to be de-serialized and returned
105            my $req = $test->request( POST '/deserialize',
106                             'Content-Type' => $content_type,
107                             content        => $s->{value} );
108
109            my $content = $req->content;
110            $content =~ s/\s//g;
111            is( $req->code, 200, "[/$format] Deserialize: correct status" );
112            is( $content, $s->{last_val}, "[/$format] Deserialize: correct content" );
113
114        } #/ for my $content_type
115    }; #/ subtest
116
117} #/ for my $format
118