The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
use Test::More;
use Test::TCP;
use LWP::UserAgent;
use Dancer2;

test_tcp(
    server => sub {
        my $port = shift;
        set startup_info => 0;
        get '/'          => sub {
            'home:' . join( ',', params );
        };
        get '/bounce/' => sub {
            return forward '/';
        };
        get '/bounce/:withparams/' => sub {
            return forward '/';
        };
        get '/bounce2/adding_params/' => sub {
            return forward '/', { withparams => 'foo' };
        };
        post '/simple_post_route/' => sub {
            'post:' . join( ',', params );
        };
        get '/go_to_post/' => sub {
            return forward '/simple_post_route/', { foo => 'bar' },
              { method => 'post' };
        };
        post '/'        => sub {'post-home'};
        post '/bounce/' => sub { forward('/') };

        print STDERR "Running on port $port\n";

        # we're overiding a RO attribute only for this test!
        Dancer2->runner->{'port'} = $port;

        print STDERR "Starting\n";
        start;
    },
    client => sub {
        my ( $port, $server_pid ) = @_;
        my $ua  = LWP::UserAgent->new;
        my $res = $ua->get("http://127.0.0.1:$port/");
        is $res->code      => 200;
        like $res->content => qr/home:/;

        $res = $ua->get("http://127.0.0.1:$port/bounce/");
        is $res->code      => 200;
        like $res->content => qr/home:/;

        $res = $ua->get("http://127.0.0.1:$port/bounce/thesethings/");
        is $res->code    => 200;
        is $res->content => 'home:withparams,thesethings';

        $res = $ua->get("http://127.0.0.1:$port/bounce2/adding_params/");
        is $res->code    => 200;
        is $res->content => 'home:withparams,foo';

        $res = $ua->get("http://127.0.0.1:$port/go_to_post/");
        is $res->code    => 200;
        is $res->content => 'post:foo,bar';

        $res = $ua->get("http://127.0.0.1:$port/bounce/");
        is $res->header('Content-Length') => 5;
        is $res->header('Content-Type')   => 'text/html; charset=UTF-8';
        is $res->header('Server')         =>
            "Perl Dancer2 $Dancer2::VERSION, Perl Dancer2 $Dancer2::VERSION";

        $res = $ua->post("http://127.0.0.1:$port/");
        is $res->code    => 200;
        is $res->content => 'post-home';

        $res = $ua->post("http://127.0.0.1:$port/bounce/");
        is $res->code                     => 200;
        is $res->content                  => 'post-home';
        is $res->header('Content-Length') => 9;
        is $res->header('Content-Type')   => 'text/html; charset=UTF-8';
        is $res->header('Server')         =>
            "Perl Dancer2 $Dancer2::VERSION, Perl Dancer2 $Dancer2::VERSION";
    }
);

done_testing;