view release on metacpan or  search on metacpan

t/basic.t  view on Meta::CPAN

{
    my $res = request('/logout');

    # Unfortunately HTTP::Cookies will just ignore a cookie with no
    # value.
    my $cookie = $res->header('Set-Cookie');
    my ($expires) = $cookie =~ /expires=(.+)(?:;|\z)/;

    like(
        $cookie, qr/^authen-cookie=(.*);/,
        'value is explicitly empty'
    );
    cmp_ok(
        str2time($expires), '<', time,
        'cookie has explicit expiration in the past'
    );
}

{
    my $res = request('/logout');

    my %cookies = cookies($res);
    my $cookie  = $cookies{'authen-cookie'};

    ok(
        !keys %{ $cookie->{value} },
        'cookie value is empty'
    );
}

{
    TestApp->config()->{authen_cookie} = {
        mac_secret => 'the knife',
        name       => 'my-cookie',
        path       => '/path',
        secure     => 1,

        # Cannot just use any random thing, because it needs to
        # match the fake request associated with the response.
        domain => '.local',
    };
}

{
    my $res = request('/login');

    my %cookies = cookies($res);

    my $cookie = $cookies{'my-cookie'};

    ok( $cookie, 'cookie name is my-cookie' );
    is( $cookie->{path}, '/path', 'cookie path is /path' );
    ok( $cookie->{secure}, 'cookie path is SSL-only' );
    is( $cookie->{domain}, '.local', 'cookie domain is .local' );
}

sub cookies {
    my $res = shift;

    my $request = HTTP::Request->new( GET => 'http://localhost/' );
    $res->request($request);

    my $jar = HTTP::Cookies->new();
    $jar->extract_cookies($res);

    my %cookies;
    my $extract = sub {
        my (
            undef, $name, $val,    $path, $domain,
            undef, undef, $secure, $expires,
            undef, undef
        ) = @_;

        my %value = map { unescape($_) } split /&/, $val;

        $cookies{$name} = {
            value   => \%value,
            path    => $path,
            domain  => $domain,
            secure  => $secure,
            expires => ( $expires ? time2str($expires) : undef ),
        };
    };

    $jar->scan($extract);

    return %cookies;
}