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