sub finalize_cookies {
my $c = shift;
+ if ( $c->sessionid) {
+ $c->update_session_cookie( $c->make_session_cookie );
+ }
+
+ return $c->NEXT::finalize_cookies(@_);
+}
+
+sub update_session_cookie {
+ my ( $c, $updated ) = @_;
my $cookie_name = $c->config->{session}{cookie_name};
+ $c->response->cookies->{$cookie_name} = $updated;
+}
- if ( my $sid = $c->sessionid ) {
- my $cookie = $c->request->cookies->{$cookie_name};
- if ( !$cookie or $cookie->value ne $sid ) {
- $c->response->cookies->{$cookie_name} = {
- value => $sid,
- expires => $c->session->{__expires},
- };
- if ( my $domain = $c->config->{session}{cookie_domain} ) {
- $c->response->cookies->{$cookie_name}->{domain} = $domain;
- }
- $c->log->debug(qq/A cookie with the session id "$sid" was saved/)
- if $c->debug;
- }
- }
+sub make_session_cookie {
+ my $c = shift;
- return $c->NEXT::finalize_cookies(@_);
+ my $cfg = $c->config->{session};
+ my $cookie = {
+ value => $c->sessionid,
+ ($cfg->{cookie_domain} ? (domain => $cfg->{cookie_domain}) : ()),
+ };
+
+ if ( exists $cfg->{cookie_expires} ) {
+ if ( my $ttl = $cfg->{cookie_expires} ) {
+ $cookie->{expires} = time() + $ttl;
+ } # else { cookie is non-persistent }
+ } else {
+ $cookie->{expires} = $c->session->{__expires};
+ }
+
+ return $cookie;
}
sub prepare_cookies {
=back
+=item CAVEATS
+
+Sessions have to be created before the first write to be saved. For example:
+
+ sub action : Local {
+ my ( $self, $c ) = @_;
+ $c->res->write("foo");
+ $c->session( ... );
+ ...
+ }
+
+Will cause a session ID to not be set, because by the time a session is
+actually created the headers have already been sent to the client.
+
=head1 SEE ALSO
L<Catalyst>, L<Catalyst::Plugin::Session>.
can_ok( $m, "finalize_cookies" );
$cxt->finalize_cookies;
+{ local $TODO = "This check is a pain to write, should be done by catalyst itself";
ok( !$res->called("cookies"),
"response cookie was not set since res cookie is already there" );
+}
$cxt->clear;
$sessionid = undef;
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+ eval { require Test::WWW::Mechanize::Catalyst };
+ plan skip_all =>
+ "This test requires Test::WWW::Mechanize::Catalyst in order to run"
+ if $@;
+ plan 'no_plan';
+}
+
+{
+
+ package CookieTestApp;
+ use Catalyst qw/
+ Session
+ Session::Store::Dummy
+ Session::State::Cookie
+ /;
+
+ sub page : Local {
+ my ( $self, $c ) = @_;
+ $c->res->body( "Hi! hit number " . ++$c->session->{counter} );
+ }
+
+ sub stream : Local {
+ my ( $self, $c ) = @_;
+ my $count = ++$c->session->{counter};
+ $c->res->write("hit number ");
+ $c->res->write( $count );
+ }
+
+ __PACKAGE__->setup;
+}
+
+use Test::WWW::Mechanize::Catalyst qw/CookieTestApp/;
+
+my $m = Test::WWW::Mechanize::Catalyst->new;
+
+$m->get_ok("http://foo.com/stream", "get page");
+$m->content_contains("hit number 1", "session data created");
+
+my $expired;
+$m->cookie_jar->scan(sub { $expired = $_[8] });
+
+$m->get_ok("http://foo.com/page", "get page");
+$m->content_contains("hit number 2", "session data restored");
+
+$m->get_ok("http://foo.com/stream", "get stream");
+$m->content_contains("hit number 3", "session data restored");
+
+sleep 1;
+
+$m->get_ok("http://foo.com/page", "get stream");
+$m->content_contains("hit number 4", "session data restored");
+
+my $updated_expired;
+$m->cookie_jar->scan(sub { $updated_expired = $_[8] });
+
+cmp_ok( $expired, "<", $updated_expired, "cookie expiration was extended");