1package HTTP::Session; 2use strict; 3use warnings; 4use base qw/Class::Accessor::Fast/; 5use 5.00800; 6our $VERSION = '0.49'; 7use Carp (); 8use Scalar::Util (); 9use Module::Runtime (); 10 11__PACKAGE__->mk_ro_accessors(qw/store request sid_length save_modified_session_only/); 12__PACKAGE__->mk_accessors(qw/session_id _data is_changed is_fresh state/); 13 14sub new { 15 my $class = shift; 16 my %args = ref($_[0]) ? %{$_[0]} : @_; 17 # check required parameters 18 for my $key (qw/store state request/) { 19 Carp::croak "missing parameter $key" unless $args{$key}; 20 } 21 # set default values 22 $args{_data} ||= {}; 23 $args{save_modified_session_only} ||= 0; 24 $args{is_changed} ||= 0; 25 $args{is_fresh} ||= 0; 26 $args{sid_length} ||= 32; 27 $args{id} ||= 'HTTP::Session::ID::SHA1'; 28 my $self = bless {%args}, $class; 29 $self->_load_session(); 30 Carp::croak "[BUG] we have bug" unless $self->{request}; 31 $self; 32} 33 34sub _load_session { 35 my $self = shift; 36 37 my $session_id = $self->state->get_session_id($self->request); 38 if ( $session_id ) { 39 my $data = $self->store->select($session_id); 40 if ($data) { 41 $self->session_id( $session_id ); 42 $self->_data($data); 43 } else { 44 if ($self->state->permissive) { 45 $self->session_id( $session_id ); 46 $self->is_fresh(1); 47 } else { 48 # session was expired? or session fixation? 49 # regen session id. 50 $self->session_id( $self->_generate_session_id() ); 51 $self->is_fresh(1); 52 } 53 } 54 } else { 55 # no sid; generate it 56 $self->session_id( $self->_generate_session_id() ); 57 $self->is_fresh(1); 58 } 59} 60 61sub _generate_session_id { 62 my $self = shift; 63 Module::Runtime::require_module($self->{id}) or die $@; 64 $self->{id}->generate_id($self->sid_length); 65} 66 67sub response_filter { 68 my ($self, $response) = @_; 69 Carp::croak "missing response" unless ref $response; 70 71 $self->state->response_filter($self->session_id, $response); 72} 73 74sub finalize { 75 my ($self, ) = @_; 76 77 if ($self->is_fresh) { 78 if ($self->is_changed || !$self->save_modified_session_only) { 79 $self->store->insert( $self->session_id, $self->_data ); 80 } 81 } else { 82 if ($self->is_changed) { 83 $self->store->update( $self->session_id, $self->_data ); 84 } 85 } 86 87 delete $self->{$_} for keys %$self; 88 bless $self, 'HTTP::Session::Finalized'; 89} 90 91sub DESTROY { 92 my $self = shift; 93 94 if ($self->{store}) { 95 $self->finalize(); 96 } else { 97 # this case happen at global destruction? 98 Carp::carp "you should call HTTP::Session->finalize method manually"; 99 } 100} 101 102sub keys { 103 my $self = shift; 104 return keys %{ $self->_data }; 105} 106 107sub get { 108 my ($self, $key) = @_; 109 $self->_data->{$key}; 110} 111 112sub set { 113 my ($self, $key, $val) = @_; 114 $self->is_changed(1); 115 $self->_data->{$key} = $val; 116} 117 118sub remove { 119 my ( $self, $key ) = @_; 120 $self->is_changed(1); 121 delete $self->_data->{$key}; 122} 123 124sub as_hashref { 125 my $self = shift; 126 return { %{ $self->_data } }; # shallow copy 127} 128 129sub expire { 130 my $self = shift; 131 $self->store->delete($self->session_id); 132 133 # XXX tricky bit to unlock 134 delete $self->{$_} for qw(is_fresh is_changed); 135 $self->DESTROY; 136 137 # rebless to null class 138 bless $self, 'HTTP::Session::Expired'; 139} 140 141sub regenerate_session_id { 142 my ($self, $delete_old) = @_; 143 $self->_data( { %{ $self->_data } } ); 144 145 if ($delete_old) { 146 my $oldsid = $self->session_id; 147 $self->store->delete($oldsid); 148 } 149 my $session_id = $self->_generate_session_id(); 150 $self->session_id( $session_id ); 151 $self->is_fresh(1); 152} 153 154BEGIN { 155 no strict 'refs'; 156 for my $meth (qw/redirect_filter header_filter html_filter/) { 157 *{__PACKAGE__ . '::' . $meth} = sub { 158 my ($self, $stuff) = @_; 159 if ($self->state->can($meth)) { 160 $self->state->$meth($self->session_id, $stuff); 161 } else { 162 $stuff; 163 } 164 }; 165 } 166} 167 168package HTTP::Session::Finalized; 169sub is_fresh { 0 } 170sub AUTOLOAD { } 171 172package HTTP::Session::Expired; 173sub is_fresh { 0 } 174sub AUTOLOAD { } 175 1761; 177__END__ 178 179=encoding utf8 180 181=head1 NAME 182 183HTTP::Session - simple session 184 185=head1 SYNOPSIS 186 187 use HTTP::Session; 188 189 my $session = HTTP::Session->new( 190 store => HTTP::Session::Store::Memcached->new( 191 memd => Cache::Memcached->new({ 192 servers => ['127.0.0.1:11211'], 193 }), 194 ), 195 state => HTTP::Session::State::Cookie->new( 196 name => 'foo_sid' 197 ), 198 request => $c->req, 199 ); 200 201=head1 DESCRIPTION 202 203Yet another session manager. 204 205easy to integrate with L<PSGI> =) 206 207=head1 METHODS 208 209=over 4 210 211=item my $session = HTTP::Session->new(store => $store, state => $state, request => $req) 212 213This method creates new instance of HTTP::Session. 214 215C<store> is instance of HTTP::Session::Store::*. 216 217C<state> is instance of HTTP::Session::State::*. 218 219C<request> is duck typed object.C<request> object should have C<header>, C<address>, C<param>. 220You can use PSGI's $env instead. 221 222=item $session->html_filter($html) 223 224filtering HTML 225 226=item $session->redirect_filter($url) 227 228filtering redirect URL 229 230=item $session->header_filter($res) 231 232filtering header 233 234=item $session->response_filter($res) 235 236filtering response. this method runs html_filter, redirect_filter and header_filter. 237 238$res should be PSGI's response array, instance of L<HTTP::Response>, or L<HTTP::Engine::Response>. 239 240=item $session->keys() 241 242keys of session. 243 244=item $session->get(key) 245 246get session item 247 248=item $session->set(key, val) 249 250set session item 251 252=item $session->remove(key) 253 254remove item. 255 256=item $session->as_hashref() 257 258session as hashref. 259 260=item $session->expire() 261 262expire the session 263 264=item $session->regenerate_session_id([$delete_old]) 265 266regenerate session id.remove old one when $delete_old is true value. 267 268=item $session->finalize() 269 270commit the session data. 271 272=back 273 274=head1 CLEANUP SESSION 275 276Some storage doesn't care the old session data.Please call $store->cleanup( $min ); manually. 277 278=head1 AUTHOR 279 280Tokuhiro Matsuno E<lt>tokuhirom AAJKLFJEF GMAIL COME<gt> 281 282=head1 THANKS TO 283 284 kazuhooku 285 amachang 286 walf443 287 yappo 288 nekokak 289 290=head1 REPOSITORY 291 292I use github. 293repo url is here L<http://github.com/tokuhirom/http-session/tree/master> 294 295=head1 SEE ALSO 296 297L<Catalyst::Plugin::Session>, L<Sledge::Session> 298 299=head1 LICENSE 300 301This library is free software; you can redistribute it and/or modify 302it under the same terms as Perl itself. 303 304=cut 305