The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use Plack::Test;

use HTTP::Request::Common;
use Web::Request;

{
    my $app = sub {
        my $env = shift;
        my $req = Web::Request->new_from_env($env);
        my $res = $req->new_response(sub {
            my $responder = shift;
            $responder->([ 200, ['X-Thing' => 'stuff'], ["foo"] ]);
        });

        $res->cookies->{t1} = { value => "bar", domain => '.example.com', path => '/cgi-bin' };
        $res->cookies->{t2} = { value => "xxx yyy", expires => time + 3600 };
        $res->cookies->{t3} = { value => "123123", "max-age" => 15 };

        $res->finalize;
    };

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

        {
            my $res = $cb->(GET "/");

            ok($res->is_success)
                || diag($res->status_line . "\n" . $res->content);

            is(scalar($res->header('X-Thing')), 'stuff');

            my @v = sort $res->header('Set-Cookie');
            is $v[0], "t1=bar; domain=.example.com; path=/cgi-bin";
            like $v[1], qr/t2=xxx%20yyy; expires=\w+, \d+-\w+-\d+ \d\d:\d\d:\d\d GMT/;
            is $v[2], "t3=123123; max-age=15";

            is($res->content, "foo");
        }
    };
}

{
    my $app = sub {
        my $env = shift;
        my $req = Web::Request->new_from_env($env);
        my $res = $req->new_response(sub {
            my $responder = shift;
            my $writer = $responder->([ 200, ['X-Thing' => 'stuff'] ]);
            $writer->write("foo");
            $writer->write("bar");
            $writer->close;
        });

        $res->cookies->{t1} = { value => "bar", domain => '.example.com', path => '/cgi-bin' };
        $res->cookies->{t2} = { value => "xxx yyy", expires => time + 3600 };
        $res->cookies->{t3} = { value => "123123", "max-age" => 15 };

        $res->finalize;
    };

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

        {
            my $res = $cb->(GET "/");

            ok($res->is_success)
                || diag($res->status_line . "\n" . $res->content);

            is(scalar($res->header('X-Thing')), 'stuff');

            my @v = sort $res->header('Set-Cookie');
            is $v[0], "t1=bar; domain=.example.com; path=/cgi-bin";
            like $v[1], qr/t2=xxx%20yyy; expires=\w+, \d+-\w+-\d+ \d\d:\d\d:\d\d GMT/;
            is $v[2], "t3=123123; max-age=15";

            is($res->content, "foobar");
        }
    };
}

{
    use utf8;
    my $app = sub {
        my $env = shift;
        my $req = Web::Request->new_from_env($env);
        my $res = $req->new_response(sub {
            my $responder = shift;
            $responder->([ 200, ['X-Thing' => 'stuff'], ["café"] ]);
        });

        $res->cookies->{t1} = { value => "bar", domain => '.example.com', path => '/cgi-bin' };
        $res->cookies->{t2} = { value => "xxx yyy", expires => time + 3600 };
        $res->cookies->{t3} = { value => "123123", "max-age" => 15 };

        $res->finalize;
    };

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

        {
            my $res = $cb->(GET "/");

            ok($res->is_success)
                || diag($res->status_line . "\n" . $res->content);

            is(scalar($res->header('X-Thing')), 'stuff');

            my @v = sort $res->header('Set-Cookie');
            is $v[0], "t1=bar; domain=.example.com; path=/cgi-bin";
            like $v[1], qr/t2=xxx%20yyy; expires=\w+, \d+-\w+-\d+ \d\d:\d\d:\d\d GMT/;
            is $v[2], "t3=123123; max-age=15";

            is($res->content, "caf\xe9");
        }
    };
}

{
    use utf8;

    my $app = sub {
        my $env = shift;
        my $req = Web::Request->new_from_env($env);
        my $res = $req->new_response(sub {
            my $responder = shift;
            my $writer = $responder->([ 200, ['X-Thing' => 'stuff'] ]);
            $writer->write("ca");
            $writer->write("fé");
            $writer->close;
        });

        $res->cookies->{t1} = { value => "bar", domain => '.example.com', path => '/cgi-bin' };
        $res->cookies->{t2} = { value => "xxx yyy", expires => time + 3600 };
        $res->cookies->{t3} = { value => "123123", "max-age" => 15 };

        $res->finalize;
    };

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

        {
            my $res = $cb->(GET "/");

            ok($res->is_success)
                || diag($res->status_line . "\n" . $res->content);

            is(scalar($res->header('X-Thing')), 'stuff');

            my @v = sort $res->header('Set-Cookie');
            is $v[0], "t1=bar; domain=.example.com; path=/cgi-bin";
            like $v[1], qr/t2=xxx%20yyy; expires=\w+, \d+-\w+-\d+ \d\d:\d\d:\d\d GMT/;
            is $v[2], "t3=123123; max-age=15";

            is($res->content, "caf\xe9");
        }
    };
}

{
    use utf8;
    my $app = sub {
        my $env = shift;
        my $req = Web::Request->new_from_env($env);
        $req->encoding('UTF-8');
        my $res = $req->new_response(sub {
            my $responder = shift;
            $responder->([ 200, ['X-Thing' => 'stuff'], ["café"] ]);
        });

        $res->cookies->{t1} = { value => "bar", domain => '.example.com', path => '/cgi-bin' };
        $res->cookies->{t2} = { value => "xxx yyy", expires => time + 3600 };
        $res->cookies->{t3} = { value => "123123", "max-age" => 15 };

        $res->finalize;
    };

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

        {
            my $res = $cb->(GET "/");

            ok($res->is_success)
                || diag($res->status_line . "\n" . $res->content);

            is(scalar($res->header('X-Thing')), 'stuff');

            my @v = sort $res->header('Set-Cookie');
            is $v[0], "t1=bar; domain=.example.com; path=/cgi-bin";
            like $v[1], qr/t2=xxx%20yyy; expires=\w+, \d+-\w+-\d+ \d\d:\d\d:\d\d GMT/;
            is $v[2], "t3=123123; max-age=15";

            is($res->content, "caf\xc3\xa9");
        }
    };
}

{
    use utf8;

    my $app = sub {
        my $env = shift;
        my $req = Web::Request->new_from_env($env);
        $req->encoding('UTF-8');
        my $res = $req->new_response(sub {
            my $responder = shift;
            my $writer = $responder->([ 200, ['X-Thing' => 'stuff'] ]);
            $writer->write("ca");
            $writer->write("fé");
            $writer->close;
        });

        $res->cookies->{t1} = { value => "bar", domain => '.example.com', path => '/cgi-bin' };
        $res->cookies->{t2} = { value => "xxx yyy", expires => time + 3600 };
        $res->cookies->{t3} = { value => "123123", "max-age" => 15 };

        $res->finalize;
    };

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

        {
            my $res = $cb->(GET "/");

            ok($res->is_success)
                || diag($res->status_line . "\n" . $res->content);

            is(scalar($res->header('X-Thing')), 'stuff');

            my @v = sort $res->header('Set-Cookie');
            is $v[0], "t1=bar; domain=.example.com; path=/cgi-bin";
            like $v[1], qr/t2=xxx%20yyy; expires=\w+, \d+-\w+-\d+ \d\d:\d\d:\d\d GMT/;
            is $v[2], "t3=123123; max-age=15";

            is($res->content, "caf\xc3\xa9");
        }
    };
}

done_testing;