Changeset 22273

Show
Ignore:
Timestamp:
10/28/08 14:24:40 (5 years ago)
Author:
tokuhirom
Message:

- only send fresh headers
- rewrite construct_session method

Location:
lang/perl/Sledge-HTTPSession/trunk
Files:
1 removed
3 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/Sledge-HTTPSession/trunk/lib/Sledge/HTTPSession/Plugin.pm

    r22146 r22273  
    44use HTTP::Session; 
    55use Sledge::HTTPSession::Session; 
    6 use Sledge::HTTPSession::SessionManager; 
    76use Sledge::HTTPSession::Request; 
    87use Sledge::HTTPSession::Response; 
    … …  
    3635 
    3736    }; 
    38     *{"$pkg\::create_manager"} = \&_create_manager; 
     37    *{"$pkg\::create_manager"}    = \&_create_manager; 
     38    *{"$pkg\::construct_session"} = \&_construct_session; 
    3939} 
    4040 
    41 sub _create_manager { 
     41sub _create_manager { } 
     42 
     43sub _construct_session { 
    4244    my $self    = shift; 
    4345    my $store   = $self->create_session_store(); 
    … …  
    4951        _page   => $self, 
    5052    ); 
    51     my $res = Sledge::HTTPSession::Response->new( $self->r ); 
    52     $session->header_filter($res); 
    53     return Sledge::HTTPSession::SessionManager->new( $session ); 
     53    if ($session->is_fresh) { 
     54        my $res = Sledge::HTTPSession::Response->new( $self->r ); 
     55        $session->header_filter($res); 
     56    } 
     57    $self->session($session); 
    5458} 
    5559 

  • lang/perl/Sledge-HTTPSession/trunk/t/01_cookie.t

    r22146 r22273  
    11use strict; 
    22use warnings; 
    3 use Test::More tests => 3; 
     3use Test::More tests => 6; 
    44use CGI; 
    55use t::Pages; 
    … …  
    77use HTTP::Session::State::Cookie; 
    88 
    9 my $r = t::Request->new( 
    10     in => { 
    11         'Cookie' => 'http_session_sid=deadbeaf; path=/', 
    12     }, 
    13 ); 
    14 my $store = HTTP::Session::Store::Test->new( 
    15     data => { 
    16         'deadbeaf' => { }, 
    17     }, 
    18 ); 
    19 my $page = t::Pages->new( 
    20     r => $r, 
    21     store => $store, 
    22     state => HTTP::Session::State::Cookie->new(), 
    23     callback => sub { 
    24         my $self = shift; 
    25         isa_ok $self->session, 'Sledge::HTTPSession::Session'; 
    26         is $self->session->session_id, 'deadbeaf'; 
    27         $self->session->param('foo' => 'bar'); 
    28         $self->content('foobar'); 
    29     }, 
    30 ); 
    31 $page->dispatch; 
    32 like $r->{out}->{'Set-Cookie'}, qr{^http_session_sid=deadbeaf; path=/$}, 'set-cookie header'; 
     9sub { 
     10    # first request 
     11    my $r = t::Request->new( 
     12        in => { }, 
     13    ); 
     14    my $store = HTTP::Session::Store::Test->new( 
     15        data => { }, 
     16    ); 
     17    my $page = t::Pages->new( 
     18        r => $r, 
     19        store => $store, 
     20        state => HTTP::Session::State::Cookie->new(), 
     21        callback => sub { 
     22            my $self = shift; 
     23            isa_ok $self->session, 'Sledge::HTTPSession::Session'; 
     24            like $self->session->session_id, qr/^[a-z0-9]{32}$/; 
     25            $self->session->param('foo' => 'bar'); 
     26            $self->content('foobar'); 
     27        }, 
     28    ); 
     29    $page->dispatch; 
     30    like $r->{out}->{'Set-Cookie'}, qr{^http_session_sid=[a-z0-9]{32}; path=/$}, 'set-cookie header'; 
     31}->(); 
     32 
     33sub { 
     34    # second request 
     35    my $r = t::Request->new( 
     36        in => { 
     37            'Cookie' => 'http_session_sid=deadbeaf; path=/', 
     38        }, 
     39    ); 
     40    my $store = HTTP::Session::Store::Test->new( 
     41        data => { 
     42            'deadbeaf' => { }, 
     43        }, 
     44    ); 
     45    my $page = t::Pages->new( 
     46        r => $r, 
     47        store => $store, 
     48        state => HTTP::Session::State::Cookie->new(), 
     49        callback => sub { 
     50            my $self = shift; 
     51            isa_ok $self->session, 'Sledge::HTTPSession::Session'; 
     52            is $self->session->session_id, 'deadbeaf'; 
     53            $self->session->param('foo' => 'bar'); 
     54            $self->content('foobar'); 
     55        }, 
     56    ); 
     57    $page->dispatch; 
     58    is $r->{out}->{'Set-Cookie'}, undef, "don't send set-cookie header"; 
     59}->(); 
     60 

  • lang/perl/Sledge-HTTPSession/trunk/t/Pages.pm

    r22146 r22273  
    3535has manager => ( 
    3636    is => 'rw', 
     37    default => sub { shift->create_manager }, 
    3738); 
    3839has r => ( 
    … …  
    6970    push @{$self->{filters}}, $filter; 
    7071} 
     72sub init_dispatch { 
     73    my ($self, $page) = @_; 
     74    $self->construct_session(); 
     75} 
    7176sub dispatch { 
    7277    my ($self, $page) = @_; 
    7378 
    74     $self->manager( $self->create_manager ); 
    75     my $session = $self->manager()->get_session; 
    76     $self->session( $session ); 
    77     $self->manager->set_session( $session ) if $session->is_fresh; 
    78  
    79     $self->call_trigger('BEFORE_DISPATCH'); 
     79    $self->init_dispatch(); 
     80    $self->call_trigger('BEFORE_DISPATCH') unless $self->finished; 
    8081    $self->callback->($self); 
    8182    if (!$self->finished) {