diff -Naur Dancer-1.3019_02/blib/lib/Dancer/Renderer.pm Dancer-1.3019_02_session/blib/lib/Dancer/Renderer.pm --- Dancer-1.3019_02/blib/lib/Dancer/Renderer.pm 2011-03-20 11:51:55.000000000 +0100 +++ Dancer-1.3019_02_session/blib/lib/Dancer/Renderer.pm 2011-03-20 11:23:48.000000000 +0100 @@ -14,6 +14,7 @@ use Dancer::Config 'setting'; use Dancer::FileUtils qw(path dirname read_file_content open_file); use Dancer::SharedData; +use Dancer::Session; use Dancer::Logger; use Dancer::MIME; @@ -83,6 +84,9 @@ my $handler = Dancer::App->find_route_through_apps(Dancer::SharedData->request); + # Read session + my $session = setting('session') ? Dancer::Session::get() : undef; + # run the before filters, before "running" the route handler my $app = Dancer::App->current; $app = $handler->{app} if ($handler); @@ -121,6 +125,8 @@ serialize_response_if_needed(); my $resp = Dancer::SharedData->response(); $_->($resp) for (@{$app->registry->hooks->{after}}); + # Write session + Dancer::Session::close() if ($session); return $resp; } else { diff -Naur Dancer-1.3019_02/blib/lib/Dancer/Session/Abstract.pm Dancer-1.3019_02_session/blib/lib/Dancer/Session/Abstract.pm --- Dancer-1.3019_02/blib/lib/Dancer/Session/Abstract.pm 2011-03-20 11:51:55.000000000 +0100 +++ Dancer-1.3019_02_session/blib/lib/Dancer/Session/Abstract.pm 2011-03-20 11:21:11.000000000 +0100 @@ -85,7 +85,7 @@ } sub write_session_id { - my ($class, $id) = @_; + my ($class, $id, $exp) = @_; my $name = session_name(); my %cookie = ( @@ -93,7 +93,10 @@ value => $id, secure => setting('session_secure') ); - if (my $expires = setting('session_expires')) { + if (defined $exp) { + $cookie{expires} = $exp; + } + elsif (my $expires = setting('session_expires')) { $cookie{expires} = Dancer::Cookie::_epoch_to_gmtstring(time + $expires); } diff -Naur Dancer-1.3019_02/blib/lib/Dancer/Session.pm Dancer-1.3019_02_session/blib/lib/Dancer/Session.pm --- Dancer-1.3019_02/blib/lib/Dancer/Session.pm 2011-03-20 11:51:55.000000000 +0100 +++ Dancer-1.3019_02_session/blib/lib/Dancer/Session.pm 2011-03-20 11:50:55.000000000 +0100 @@ -5,6 +5,10 @@ use Dancer::Cookies; use Dancer::Engine; +use Dancer::Config 'setting'; +use Carp; + +my $PRIVATE_FIELD = 'dancer.session.private'; # Singleton representing the session engine class to use my $ENGINE = undef; @@ -19,7 +23,10 @@ } # retrieve or create a session for the client +my $own_cs = undef; + sub get_current_session { + return $own_cs if (defined($own_cs)); my $sid = engine->read_session_id; my $session = undef; my $class = ref(engine); @@ -27,12 +34,66 @@ $session = $class->retrieve($sid) if $sid; if (not defined $session) { + RE_INIT: $session = $class->create(); - engine->write_session_id($session->id); + + # Put expiration time to session + my $t = time; + foreach ("_SESSION_CTIME", "_SESSION_ATIME") { + $session->{$PRIVATE_FIELD}->{$_} = $t; + } + $session->{$PRIVATE_FIELD}->{_SESSION_REMOTE_ADDR} = _remote_address() + || ""; + } + else { + + # checking ip match + if (setting('sesions_ip_match')) { + my $r = _remote_address(); + if ( !$r + || !exists($session->{$PRIVATE_FIELD}->{_SESSION_REMOTE_ADDR}) + || $r ne $session->{$PRIVATE_FIELD}->{_SESSION_REMOTE_ADDR}) + { + engine->destroy(); + goto RE_INIT; + } + } + + # checking for expiration ticker + if ($session->{$PRIVATE_FIELD}->{_SESSION_ETIME}) { + if (( $session->{$PRIVATE_FIELD}->{_SESSION_ATIME} + + $session->{$PRIVATE_FIELD}->{_SESSION_ETIME} + ) <= time() + ) + { + engine->destroy(); + goto RE_INIT; + } + } + + # checking expiration tickers of individuals parameters, if any: + while (my ($param, $max_exp_interval) = + each %{$session->{$PRIVATE_FIELD}->{_SESSION_EXPIRE_LIST}}) + { + if (($session->{$PRIVATE_FIELD}->{_SESSION_ATIME} + $max_exp_interval) <= time()) + { + delete($session->{param}); + } + } + + # We update the atime by default + $session->{$PRIVATE_FIELD}->{_SESSION_ATIME} = time; } + $own_cs = $session; return $session; } +sub _remote_address { + + # Put function to return remote IP adress + return undef; +} + sub get { get_current_session() } sub read { @@ -44,13 +105,131 @@ sub write { my ($class, $key, $value) = @_; my $session = get_current_session(); - $session->{$key} = $value; - # TODO : should be moved as an "after" filter - $session->flush; + # BUG : Don't change ID of session with putted param with name 'id' + if ($key && $key ne "id" && $key ne $PRIVATE_FIELD) { + if (!defined($value)) { + delete($session->{$key}); + } + else { + $session->{$key} = $value; + } + } + return $value; } +sub close { + my $session = get_current_session(); + if (exists($session->{$PRIVATE_FIELD}->{_SESSION_ETIME})) { + engine->write_session_id($session->id, '+' . $session->{$PRIVATE_FIELD}->{_SESSION_ETIME} . 's'); + } + else { + engine->write_session_id($session->id); + my $se = setting('session_expires'); + $session->{$PRIVATE_FIELD}->{_SESSION_ETIME} = $se if (defined($se)); + } + $session->flush; + $own_cs = undef; +} + +sub atime { + my $session = get_current_session(); + return $session->{$PRIVATE_FIELD}->{_SESSION_ATIME}; +} + +sub ctime { + my $session = get_current_session(); + return $session->{$PRIVATE_FIELD}->{_SESSION_CTIME}; +} + +sub expire { + my $class = shift; + my $session = get_current_session(); + + # no params, just return the expiration time. + if (not @_) { + return $session->{$PRIVATE_FIELD}->{_SESSION_ETIME}; + } + + # We have just a time + elsif (@_ == 1) { + my $time = $_[0]; + + # If 0 is passed, cancel expiration + if (defined $time && ($time =~ m/^\d$/) && ($time == 0)) { + $session->{$PRIVATE_FIELD}->{_SESSION_ETIME} = undef; + } + + # set the expiration to this time + else { + $session->{$PRIVATE_FIELD}->{_SESSION_ETIME} = _str2seconds($time); + } + } + + # If we get this far, we expect expire($param,$time) + # ( This would be a great use of a Perl6 multi sub! ) + else { + my ($param, $time) = @_; + if (($time =~ m/^\d$/) && ($time == 0)) { + delete $session->{$PRIVATE_FIELD}->{_SESSION_EXPIRE_LIST} + ->{$param}; + } + else { + $session->{$PRIVATE_FIELD}->{_SESSION_EXPIRE_LIST}->{$param} = + _str2seconds($time); + } + } + return 1; +} + +sub is_expired { + my $class = shift; + my $session = get_current_session() || return 1; + + # no params, just return the expiration time. + if (not @_) { + if (($session->{$PRIVATE_FIELD}->{_SESSION_ATIME} + $session->{$PRIVATE_FIELD}->{_SESSION_ETIME}) <= time()) { + return 1; + } + } + + # We have just a time + else { + my $exp = $session->{$PRIVATE_FIELD}->{_SESSION_EXPIRE_LIST}->{$_[0]}; + if (($session->{$PRIVATE_FIELD}->{_SESSION_ATIME} + $exp) <= time()) { + delete($session->{$_[0]}); + return 1; + } + } + + return 0; +} + +sub _str2seconds { + my ($str) = @_; + + return unless defined $str; + return $str if $str =~ m/^[-+]?\d+$/; + + my %_map = ( + s => 1, + m => 60, + h => 3600, + d => 86400, + w => 604800, + M => 2592000, + y => 31536000 + ); + + my ($koef, $d) = $str =~ m/^([+-]?\d+)([smhdwMy])$/; + unless (defined($koef) && defined($d)) { + croak + "_str2seconds(): couldn't parse '$str' into \$koef and \$d parts. Possible invalid syntax"; + } + return $koef * $_map{$d}; +} + 1; __END__ @@ -118,6 +297,55 @@ L showing how to use a before filter to check whether the user is logged in before all requests, and redirect to a login page if not. +=head2 atime() + +Read-only method. Returns the last access time of the session in seconds from epoch. This time is used internally while +auto-expiring sessions and/or session parameters. + +=head2 ctime() + +Read-only method. Returns the time when the session was first created in seconds from epoch. + +=head2 expire() + +=head2 expire($time) + +=head2 expire($param, $time) + +Sets expiration interval relative to L. + +If used with no arguments, returns the expiration interval if it was ever set. If no expiration was ever set, returns undef. For backwards compatibility, a method named C does the same thing. + +Second form sets an expiration time. This value is checked when previously stored session is asked to be retrieved, and if its expiration interval has passed, it will be expunged from the disk immediately. Passing 0 cancels expiration. + +By using the third syntax you can set the expiration interval for a particular +session parameter, say I<~logged-in>. This would cause the library call clear() +on the parameter when its time is up. Note it only makes sense to set this value to +something I than when the whole session expires. Passing 0 cancels expiration. + +All the time values should be given in the form of seconds. Following keywords are also supported for your convenience: + + +-----------+---------------+ + | alias | meaning | + +-----------+---------------+ + | s | Second | + | m | Minute | + | h | Hour | + | d | Day | + | w | Week | + | M | Month | + | y | Year | + +-----------+---------------+ + +Examples: + + session_expire("2h"); # expires in two hours + session_expire(0); # cancel expiration + session_expire("~logged-in", "10m"); # expires '~logged-in' parameter after 10 idle minutes + +=head2 is_expired() + +Tests whether session initialized using L is to be expired. =head1 SUPPORTED ENGINES diff -Naur Dancer-1.3019_02/blib/lib/Dancer.pm Dancer-1.3019_02_session/blib/lib/Dancer.pm --- Dancer-1.3019_02/blib/lib/Dancer.pm 2011-03-20 11:51:55.000000000 +0100 +++ Dancer-1.3019_02_session/blib/lib/Dancer.pm 2011-03-20 11:19:44.000000000 +0100 @@ -77,6 +77,7 @@ setting set_cookie session + session_expire splat status start @@ -142,6 +143,11 @@ sub set_cookie { Dancer::Cookies->set_cookie(@_) } sub setting { Dancer::App->applications ? Dancer::App->current->setting(@_) : Dancer::Config::setting(@_) } sub session { goto &_session } +sub session_expire { + croak "Must specify session engine in settings prior to using 'session' keyword" + unless setting('session'); + return Dancer::Session->expire(@_); +} sub splat { @{ Dancer::SharedData->request->params->{splat} || [] } } sub start { goto &_start } sub status { Dancer::SharedData->response->status(@_) } diff -Naur Dancer-1.3019_02/lib/Dancer/Renderer.pm Dancer-1.3019_02_session/lib/Dancer/Renderer.pm --- Dancer-1.3019_02/lib/Dancer/Renderer.pm 2011-03-20 11:51:55.000000000 +0100 +++ Dancer-1.3019_02_session/lib/Dancer/Renderer.pm 2011-03-20 11:23:48.000000000 +0100 @@ -14,6 +14,7 @@ use Dancer::Config 'setting'; use Dancer::FileUtils qw(path dirname read_file_content open_file); use Dancer::SharedData; +use Dancer::Session; use Dancer::Logger; use Dancer::MIME; @@ -83,6 +84,9 @@ my $handler = Dancer::App->find_route_through_apps(Dancer::SharedData->request); + # Read session + my $session = setting('session') ? Dancer::Session::get() : undef; + # run the before filters, before "running" the route handler my $app = Dancer::App->current; $app = $handler->{app} if ($handler); @@ -121,6 +125,8 @@ serialize_response_if_needed(); my $resp = Dancer::SharedData->response(); $_->($resp) for (@{$app->registry->hooks->{after}}); + # Write session + Dancer::Session::close() if ($session); return $resp; } else { diff -Naur Dancer-1.3019_02/lib/Dancer/Session/Abstract.pm Dancer-1.3019_02_session/lib/Dancer/Session/Abstract.pm --- Dancer-1.3019_02/lib/Dancer/Session/Abstract.pm 2011-03-20 11:51:55.000000000 +0100 +++ Dancer-1.3019_02_session/lib/Dancer/Session/Abstract.pm 2011-03-20 11:21:11.000000000 +0100 @@ -85,7 +85,7 @@ } sub write_session_id { - my ($class, $id) = @_; + my ($class, $id, $exp) = @_; my $name = session_name(); my %cookie = ( @@ -93,7 +93,10 @@ value => $id, secure => setting('session_secure') ); - if (my $expires = setting('session_expires')) { + if (defined $exp) { + $cookie{expires} = $exp; + } + elsif (my $expires = setting('session_expires')) { $cookie{expires} = Dancer::Cookie::_epoch_to_gmtstring(time + $expires); } diff -Naur Dancer-1.3019_02/lib/Dancer/Session.pm Dancer-1.3019_02_session/lib/Dancer/Session.pm --- Dancer-1.3019_02/lib/Dancer/Session.pm 2011-03-20 11:51:55.000000000 +0100 +++ Dancer-1.3019_02_session/lib/Dancer/Session.pm 2011-03-20 11:50:55.000000000 +0100 @@ -5,6 +5,10 @@ use Dancer::Cookies; use Dancer::Engine; +use Dancer::Config 'setting'; +use Carp; + +my $PRIVATE_FIELD = 'dancer.session.private'; # Singleton representing the session engine class to use my $ENGINE = undef; @@ -19,7 +23,10 @@ } # retrieve or create a session for the client +my $own_cs = undef; + sub get_current_session { + return $own_cs if (defined($own_cs)); my $sid = engine->read_session_id; my $session = undef; my $class = ref(engine); @@ -27,12 +34,66 @@ $session = $class->retrieve($sid) if $sid; if (not defined $session) { + RE_INIT: $session = $class->create(); - engine->write_session_id($session->id); + + # Put expiration time to session + my $t = time; + foreach ("_SESSION_CTIME", "_SESSION_ATIME") { + $session->{$PRIVATE_FIELD}->{$_} = $t; + } + $session->{$PRIVATE_FIELD}->{_SESSION_REMOTE_ADDR} = _remote_address() + || ""; + } + else { + + # checking ip match + if (setting('sesions_ip_match')) { + my $r = _remote_address(); + if ( !$r + || !exists($session->{$PRIVATE_FIELD}->{_SESSION_REMOTE_ADDR}) + || $r ne $session->{$PRIVATE_FIELD}->{_SESSION_REMOTE_ADDR}) + { + engine->destroy(); + goto RE_INIT; + } + } + + # checking for expiration ticker + if ($session->{$PRIVATE_FIELD}->{_SESSION_ETIME}) { + if (( $session->{$PRIVATE_FIELD}->{_SESSION_ATIME} + + $session->{$PRIVATE_FIELD}->{_SESSION_ETIME} + ) <= time() + ) + { + engine->destroy(); + goto RE_INIT; + } + } + + # checking expiration tickers of individuals parameters, if any: + while (my ($param, $max_exp_interval) = + each %{$session->{$PRIVATE_FIELD}->{_SESSION_EXPIRE_LIST}}) + { + if (($session->{$PRIVATE_FIELD}->{_SESSION_ATIME} + $max_exp_interval) <= time()) + { + delete($session->{param}); + } + } + + # We update the atime by default + $session->{$PRIVATE_FIELD}->{_SESSION_ATIME} = time; } + $own_cs = $session; return $session; } +sub _remote_address { + + # Put function to return remote IP adress + return undef; +} + sub get { get_current_session() } sub read { @@ -44,13 +105,131 @@ sub write { my ($class, $key, $value) = @_; my $session = get_current_session(); - $session->{$key} = $value; - # TODO : should be moved as an "after" filter - $session->flush; + # BUG : Don't change ID of session with putted param with name 'id' + if ($key && $key ne "id" && $key ne $PRIVATE_FIELD) { + if (!defined($value)) { + delete($session->{$key}); + } + else { + $session->{$key} = $value; + } + } + return $value; } +sub close { + my $session = get_current_session(); + if (exists($session->{$PRIVATE_FIELD}->{_SESSION_ETIME})) { + engine->write_session_id($session->id, '+' . $session->{$PRIVATE_FIELD}->{_SESSION_ETIME} . 's'); + } + else { + engine->write_session_id($session->id); + my $se = setting('session_expires'); + $session->{$PRIVATE_FIELD}->{_SESSION_ETIME} = $se if (defined($se)); + } + $session->flush; + $own_cs = undef; +} + +sub atime { + my $session = get_current_session(); + return $session->{$PRIVATE_FIELD}->{_SESSION_ATIME}; +} + +sub ctime { + my $session = get_current_session(); + return $session->{$PRIVATE_FIELD}->{_SESSION_CTIME}; +} + +sub expire { + my $class = shift; + my $session = get_current_session(); + + # no params, just return the expiration time. + if (not @_) { + return $session->{$PRIVATE_FIELD}->{_SESSION_ETIME}; + } + + # We have just a time + elsif (@_ == 1) { + my $time = $_[0]; + + # If 0 is passed, cancel expiration + if (defined $time && ($time =~ m/^\d$/) && ($time == 0)) { + $session->{$PRIVATE_FIELD}->{_SESSION_ETIME} = undef; + } + + # set the expiration to this time + else { + $session->{$PRIVATE_FIELD}->{_SESSION_ETIME} = _str2seconds($time); + } + } + + # If we get this far, we expect expire($param,$time) + # ( This would be a great use of a Perl6 multi sub! ) + else { + my ($param, $time) = @_; + if (($time =~ m/^\d$/) && ($time == 0)) { + delete $session->{$PRIVATE_FIELD}->{_SESSION_EXPIRE_LIST} + ->{$param}; + } + else { + $session->{$PRIVATE_FIELD}->{_SESSION_EXPIRE_LIST}->{$param} = + _str2seconds($time); + } + } + return 1; +} + +sub is_expired { + my $class = shift; + my $session = get_current_session() || return 1; + + # no params, just return the expiration time. + if (not @_) { + if (($session->{$PRIVATE_FIELD}->{_SESSION_ATIME} + $session->{$PRIVATE_FIELD}->{_SESSION_ETIME}) <= time()) { + return 1; + } + } + + # We have just a time + else { + my $exp = $session->{$PRIVATE_FIELD}->{_SESSION_EXPIRE_LIST}->{$_[0]}; + if (($session->{$PRIVATE_FIELD}->{_SESSION_ATIME} + $exp) <= time()) { + delete($session->{$_[0]}); + return 1; + } + } + + return 0; +} + +sub _str2seconds { + my ($str) = @_; + + return unless defined $str; + return $str if $str =~ m/^[-+]?\d+$/; + + my %_map = ( + s => 1, + m => 60, + h => 3600, + d => 86400, + w => 604800, + M => 2592000, + y => 31536000 + ); + + my ($koef, $d) = $str =~ m/^([+-]?\d+)([smhdwMy])$/; + unless (defined($koef) && defined($d)) { + croak + "_str2seconds(): couldn't parse '$str' into \$koef and \$d parts. Possible invalid syntax"; + } + return $koef * $_map{$d}; +} + 1; __END__ @@ -118,6 +297,55 @@ L showing how to use a before filter to check whether the user is logged in before all requests, and redirect to a login page if not. +=head2 atime() + +Read-only method. Returns the last access time of the session in seconds from epoch. This time is used internally while +auto-expiring sessions and/or session parameters. + +=head2 ctime() + +Read-only method. Returns the time when the session was first created in seconds from epoch. + +=head2 expire() + +=head2 expire($time) + +=head2 expire($param, $time) + +Sets expiration interval relative to L. + +If used with no arguments, returns the expiration interval if it was ever set. If no expiration was ever set, returns undef. For backwards compatibility, a method named C does the same thing. + +Second form sets an expiration time. This value is checked when previously stored session is asked to be retrieved, and if its expiration interval has passed, it will be expunged from the disk immediately. Passing 0 cancels expiration. + +By using the third syntax you can set the expiration interval for a particular +session parameter, say I<~logged-in>. This would cause the library call clear() +on the parameter when its time is up. Note it only makes sense to set this value to +something I than when the whole session expires. Passing 0 cancels expiration. + +All the time values should be given in the form of seconds. Following keywords are also supported for your convenience: + + +-----------+---------------+ + | alias | meaning | + +-----------+---------------+ + | s | Second | + | m | Minute | + | h | Hour | + | d | Day | + | w | Week | + | M | Month | + | y | Year | + +-----------+---------------+ + +Examples: + + session_expire("2h"); # expires in two hours + session_expire(0); # cancel expiration + session_expire("~logged-in", "10m"); # expires '~logged-in' parameter after 10 idle minutes + +=head2 is_expired() + +Tests whether session initialized using L is to be expired. =head1 SUPPORTED ENGINES diff -Naur Dancer-1.3019_02/lib/Dancer.pm Dancer-1.3019_02_session/lib/Dancer.pm --- Dancer-1.3019_02/lib/Dancer.pm 2011-03-20 11:51:55.000000000 +0100 +++ Dancer-1.3019_02_session/lib/Dancer.pm 2011-03-20 11:19:44.000000000 +0100 @@ -77,6 +77,7 @@ setting set_cookie session + session_expire splat status start @@ -142,6 +143,11 @@ sub set_cookie { Dancer::Cookies->set_cookie(@_) } sub setting { Dancer::App->applications ? Dancer::App->current->setting(@_) : Dancer::Config::setting(@_) } sub session { goto &_session } +sub session_expire { + croak "Must specify session engine in settings prior to using 'session' keyword" + unless setting('session'); + return Dancer::Session->expire(@_); +} sub splat { @{ Dancer::SharedData->request->params->{splat} || [] } } sub start { goto &_start } sub status { Dancer::SharedData->response->status(@_) } diff -Naur Dancer-1.3019_02/t/08_session/13_session_expired.t Dancer-1.3019_02_session/t/08_session/13_session_expired.t --- Dancer-1.3019_02/t/08_session/13_session_expired.t 1970-01-01 01:00:00.000000000 +0100 +++ Dancer-1.3019_02_session/t/08_session/13_session_expired.t 2011-03-20 11:15:12.000000000 +0100 @@ -0,0 +1,71 @@ +use strict; +use warnings; +use Test::More import => ['!pass']; +use Dancer::ModuleLoader; +use Dancer; +use Dancer::Cookie; + +plan skip_all => "Test::TCP is needed for this test" + unless Dancer::ModuleLoader->load("Test::TCP"); +plan skip_all => "YAML is needed for this test" + unless Dancer::ModuleLoader->load("YAML"); + +plan tests => 5; + +use LWP::UserAgent; + +my $check_expires = Dancer::Cookie::_epoch_to_gmtstring(time + 42); + +my $id = undef; +sub callback { + my($data, $response, $protocol) = @_; + $id = $data; +} + +use File::Spec; +use File::Temp 'tempdir'; +my $tempdir = tempdir('Dancer.XXXXXX', DIR => File::Spec->curdir, CLEANUP => 1); + +Test::TCP::test_tcp( + client => sub { + my $port = shift; + my $ua = LWP::UserAgent->new; + $ua->cookie_jar({ file => "$tempdir/.cookies.txt" }); + + my $req1 = + HTTP::Request->new(GET => "http://127.0.0.1:$port/set_session_expire/test"); + my $res1 = $ua->request($req1, \&callback); + ok $res1->is_success, 'req1 is success'; + my $d1 = $id; + + my $req2 = + HTTP::Request->new(GET => "http://127.0.0.1:$port/set_session_expire/test"); + my $res2 = $ua->request($req2, \&callback); + ok $res2->is_success, 'req2 is success'; + my $d2 = $id; + + ok $d1 eq $d2, 'd1 is same as d2'; + print STDERR "Now sleep 3seconds\n"; + sleep(3); + + my $req = + HTTP::Request->new(GET => "http://127.0.0.1:$port/set_session_expire/test"); + my $res = $ua->request($req, \&callback); + ok $res->is_success, 'req is success'; + ok $d1 ne $id, 'd1 is not same as returned id'; + }, + server => sub { + my $port = shift; + + use File::Spec; + use lib File::Spec->catdir( 't', 'lib' ); + use TestApp; + Dancer::Config->load; + + setting session => 'YAML'; + setting environment => 'production'; + setting port => $port; + setting access_log => 0; + Dancer->dance(); + }, +); diff -Naur Dancer-1.3019_02/t/lib/TestApp.pm Dancer-1.3019_02_session/t/lib/TestApp.pm --- Dancer-1.3019_02/t/lib/TestApp.pm 2011-03-20 11:51:55.000000000 +0100 +++ Dancer-1.3019_02_session/t/lib/TestApp.pm 2011-03-20 11:15:12.000000000 +0100 @@ -54,6 +54,13 @@ session name => $name; }; +get '/set_session_expire/*' => sub { + my ($name) = splat; + session_expire(2); + my $s = session(); + return $s->{id}; +}; + get '/read_session' => sub { my $name = session('name') || ''; "name='$name'"