1package HTTP::Session::State::Cookie; 2use strict; 3use HTTP::Session::State::Base; 4use Carp (); 5use Scalar::Util (); 6 7our $COOKIE_CLASS = 'CGI::Cookie'; 8 9__PACKAGE__->mk_accessors(qw/name path domain expires secure/); 10 11{ 12 my $required = 0; 13 sub _cookie_class { 14 my $class = shift; 15 unless ($required) { 16 (my $klass = $COOKIE_CLASS) =~ s!::!/!g; 17 $klass .= ".pm"; 18 require $klass; 19 $required++; 20 } 21 return $COOKIE_CLASS 22 } 23} 24 25sub new { 26 my $class = shift; 27 my %args = ref($_[0]) ? %{$_[0]} : @_; 28 # set default values 29 $args{name} ||= 'http_session_sid'; 30 $args{path} ||= '/'; 31 bless {%args}, $class; 32} 33 34sub get_session_id { 35 my ($self, $req) = @_; 36 37 my $cookie_header = $ENV{HTTP_COOKIE} || (Scalar::Util::blessed($req) ? $req->header('Cookie') : $req->{HTTP_COOKIE}); 38 return unless $cookie_header; 39 40 my %jar = _cookie_class()->parse($cookie_header); 41 my $cookie = $jar{$self->name}; 42 return $cookie ? $cookie->value : undef; 43} 44 45sub response_filter { 46 my ($self, $session_id, $res) = @_; 47 Carp::croak "missing session_id" unless $session_id; 48 49 $self->header_filter($session_id, $res); 50} 51 52sub header_filter { 53 my ($self, $session_id, $res) = @_; 54 Carp::croak "missing session_id" unless $session_id; 55 56 my $cookie = _cookie_class()->new( 57 sub { 58 my %options = ( 59 -name => $self->name, 60 -value => $session_id, 61 -path => $self->path, 62 ); 63 $options{'-domain'} = $self->domain if $self->domain; 64 $options{'-expires'} = $self->expires if $self->expires; 65 $options{'-secure'} = $self->secure if $self->secure; 66 %options; 67 }->() 68 ); 69 if (Scalar::Util::blessed($res)) { 70 $res->header( 'Set-Cookie' => $cookie->as_string ); 71 $res; 72 } else { 73 push @{$res->[1]}, 'Set-Cookie' => $cookie->as_string; 74 $res; 75 } 76} 77 781; 79__END__ 80 81=head1 NAME 82 83HTTP::Session::State::Cookie - Maintain session IDs using cookies 84 85=head1 SYNOPSIS 86 87 HTTP::Session->new( 88 state => HTTP::Session::State::Cookie->new( 89 name => 'foo_sid', 90 path => '/my/', 91 domain => 'example.com, 92 ), 93 store => ..., 94 request => ..., 95 ); 96 97=head1 DESCRIPTION 98 99Maintain session IDs using cookies 100 101=head1 CONFIGURATION 102 103=over 4 104 105=item name 106 107cookie name. 108 109 default: http_session_sid 110 111=item path 112 113path. 114 115 default: / 116 117=item domain 118 119 default: undef 120 121=item expires 122 123expiration date.e.g. "+3M". 124see also L<CGI::Cookie>. 125 126 default: undef 127 128=item secure 129 130Set secure flag or not. 131 132 default: undef 133 134=back 135 136=head1 METHODS 137 138=over 4 139 140=item header_filter($res) 141 142header filter 143 144=item get_session_id 145 146=item response_filter 147 148for internal use only 149 150=back 151 152=head1 HOW TO USE YOUR OWN CGI::Simple::Cookie? 153 154 use HTTP::Session::State::Cookie; 155 BEGIN { 156 $HTTP::Session::State::Cookie::COOKIE_CLASS = 'CGI/Simple/Cookie.pm'; 157 } 158 159=head1 SEE ALSO 160 161L<HTTP::Session>, L<CGI::Cookie>, L<CGI::Simple::Cookie> 162 163