File Coverage

blib/lib/Catalyst/Plugin/Starch/Cookie.pm
Criterion Covered Total %
statement 24 24 100.0
branch 2 2 100.0
condition n/a
subroutine 11 11 100.0
pod 2 2 100.0
total 39 39 100.0


line stmt bran cond sub pod time code
1             package Catalyst::Plugin::Starch::Cookie;
2 1     1   7162 use 5.010001;
  1         10  
3 1     1   9 use strictures 2;
  1         10  
  1         49  
4             our $VERSION = '0.07';
5              
6             =head1 NAME
7              
8             Catalyst::Plugin::Starch::Cookie - Track starch state in a cookie.
9              
10             =head1 SYNOPSIS
11              
12             package MyApp;
13            
14             use Catalyst qw(
15             Starch::Cookie
16             Starch
17             );
18              
19             =head1 DESCRIPTION
20              
21             This plugin utilizes the L<Starch::Plugin::CookieArgs> plugin to add
22             a bunch of arguments to the Starch object, search the request cookies for
23             the session cookie, and write the session cookie at the end of the request.
24              
25             See the L<Starch::Plugin::CookieArgs> documentation for a
26             list of arguments you can specify in the Catalyst configuration for
27             L<Catalyst::Plugin::Starch>.
28              
29             =cut
30              
31 1     1   860 use Class::Method::Modifiers qw( fresh );
  1         1646  
  1         83  
32              
33 1     1   10 use Moose::Role;
  1         2  
  1         14  
34 1     1   6660 use namespace::clean;
  1         3  
  1         13  
35              
36             =head1 COMPATIBILITY
37              
38             Most of the methods documented in
39             L<Catalyst::Plugin::Session::Cookie/METHODS> are not
40             supported at this time:
41              
42             =over
43              
44             =item *
45              
46             The C<make_session_cookie>, C<calc_expiry>,
47             C<calculate_session_cookie_expires>, C<cookie_is_rejecting>,
48             C<delete_session_id>, C<extend_session_id>,
49             C<get_session_id>, and C<set_session_id> methods are not currently
50             supported but could be if necessary.
51              
52             =back
53              
54             The above listed un-implemented methods and attributes will throw an exception
55             if called.
56              
57             =cut
58              
59             # These are already blocked by Catalyst::Plugin::Starch:
60             # delete_session_id extend_session_id
61             # get_session_id set_session_id
62              
63             foreach my $method (qw(
64             make_session_cookie calc_expiry
65             calculate_session_cookie_expires cookie_is_rejecting
66             )) {
67             fresh $method => sub{
68 1     1   6129 Catalyst::Exception->throw( "The $method method is not implemented by Catalyst::Plugin::Starch::Cookie" );
        1      
        1      
        1      
69             };
70             }
71              
72             =head1 METHODS
73              
74             =head2 get_session_cookie
75              
76             Returns the L<CGI::Simple::Cookie> object from L<Catalyst::Request>
77             for the session cookie, if there is one.
78              
79             =cut
80              
81             sub get_session_cookie {
82 5     5 1 13 my ($c) = @_;
83              
84 5         139 my $cookie_name = $c->starch->cookie_name();
85 5         22 my $cookie = $c->req->cookies->{ $cookie_name };
86              
87 5         291 return $cookie;
88             }
89              
90             =head2 update_session_cookie
91              
92             This is called automatically by the C<finalize_headers> step in Catalyst. This method
93             is provided if you want to override the behavior.
94              
95             =cut
96              
97             sub update_session_cookie {
98 5     5 1 11 my ($c) = @_;
99 5 100       181 return if !$c->_has_sessionid();
100 4         103 my $cookie_name = $c->starch->cookie_name();
101 4         106 $c->res->cookies->{ $cookie_name } = $c->starch_state->cookie_args();
102 4         761 return;
103             }
104              
105             after prepare_cookies => sub{
106             my ($c) = @_;
107              
108             my $cookie = $c->get_session_cookie();
109             return if !$cookie;
110              
111             my $id = $cookie->value();
112             return if !$c->starch->state_id_type->check( $id );
113              
114             $c->_set_sessionid( $id );
115             return;
116             };
117              
118             before finalize_headers => sub{
119             my ($c) = @_;
120             $c->update_session_cookie();
121             return;
122             };
123              
124             around default_starch_plugins => sub{
125             my $orig = shift;
126             my $c = shift;
127              
128             return [
129             @{ $c->$orig() },
130             '::CookieArgs',
131             ];
132             };
133              
134             1;
135             __END__
136              
137             =head1 AUTHOR AND LICENSE
138              
139             See L<Catalyst::Plugin::Starch/AUTHOR> and
140             L<Catalyst::Plugin::Starch/LICENSE>.
141              
142             =cut
143