File: serializer_mutable.t

package info (click to toggle)
libdancer2-perl 0.152000%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 1,820 kB
  • ctags: 536
  • sloc: perl: 8,034; sh: 51; makefile: 2
file content (85 lines) | stat: -rw-r--r-- 2,504 bytes parent folder | download
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
use strict;
use warnings;

use Test::More tests => 56;
use Dancer2::Serializer::Mutable;
use Plack::Test;
use HTTP::Request::Common;
use Encode;
use JSON;
use YAML;

{
    package MyApp;

    use Dancer2;

    set serializer => 'Mutable';

    get '/serialize'  => sub {
        return { bar => 'baz' }
    };
    post '/deserialize'  => sub {
        return request->data &&
               ref request->data eq 'HASH' &&
               request->data->{bar} ? request->data->{bar} : '?';
    };
}

my $app = MyApp->to_app;
is( ref $app, 'CODE', 'Got app' );

test_psgi $app, sub {
    my $cb = shift;

    # Configure all test cases
    my $d = {
        yaml    => {
                types       => [ qw(text/x-yaml text/html) ],
                value       => encode('UTF-8', YAML::Dump({ bar => 'baz' })),
            },
        dumper  => {
                types       => [ qw(text/x-data-dumper) ],
                value       => Data::Dumper::Dumper({ bar => 'baz' }),
            },
        json    => {
                types       => [ qw(text/x-json application/json) ],
                value       => JSON::to_json({ bar => 'baz' }),
            },
    };

    {
        for my $format (keys %$d) {

            my $s = $d->{$format};

            # Response with implicit call to the serializer
            for my $content_type ( @{ $s->{types} } ) {

                for my $ct (qw/Content-Type Accept Accept-Type/) {

                    # Test getting the value serialized in the correct format
                    my $res = $cb->( GET '/serialize', $ct => $content_type );

                    is( $res->code, 200, "[/$format] Correct status" );
                    is( $res->content, $s->{value}, "[/$format] Correct content" );
                    is(
                        $res->headers->content_type,
                        $content_type,
                        "[/$format] Correct content-type headers",
                    );
                }

                # Test sending the value serialized in the correct format
                # needs to be de-serialized and returned
                my $req = $cb->( POST '/deserialize',
                                 'Content-Type' => $content_type,
                                 content        => $s->{value} );

                is( $req->code, 200, "[/$format] Correct status" );
                is( $req->content, 'baz', "[/$format] Correct content" );
            } #/ for my $content_type
        } #/ for my $format
    }

}