lib/Catalyst/Plugin/Session/State/Stash.pm

   1 package Catalyst::Plugin::Session::State::Stash;
   2 use base qw/Catalyst::Plugin::Session::State Class::Accessor::Fast/;
   3
   4 use strict;
   5 use warnings;
   6 use MRO::Compat;
   7
   8 use Data::Dumper qw/Dumper/;
   9 our $VERSION = "0.10";
  10
  11 BEGIN { __PACKAGE__->mk_accessors(qw/_deleted_session_id _prepared/) }
  12
  13 sub _stash_key_components {
  14     my ($c) = @_;
  15     return ($c->config->{session}->{stash_delim}) ?
  16         split $c->config->{session}->{stash_delim}, $c->config->{session}->{stash_key} :
  17         $c->config->{session}->{stash_key};
  18 }
  19
  20 sub _get_session {
  21     my ($c) = @_;
  22     # This turns the list of path components into a nested tree of hashrefs for obtaining info/storing in: 123/456 = {123}->{456}
  23     my $ref = $c->stash;
  24     $ref = ($ref->{$_} ||= {}) foreach $c->_stash_key_components;
  25     $ref;
  26 }
  27
  28 sub _set_session {
  29     my ( $c,$key,$value) = @_;
  30
  31     $c->_get_session->{$key} = $value;
  32 }
  33
  34 sub setup_session {
  35     my $c = shift;
  36
  37     $c->config->{session}->{stash_key}
  38         ||= '_session';
  39 }
  40
  41 sub prepare_action {
  42     my $c = shift;
  43     my $id = $c->get_session_id;
  44     $c->_prepared(1);
  45     if ( $id ) {
  46         $c->sessionid( $id );
  47     }
  48     $c->maybe::next::method( @_ );
  49 }
  50
  51 sub get_session_id {
  52     my $c = shift;
  53     if(!$c->_deleted_session_id and my $session = $c->_get_session) {
  54         my $sid = $session->{id};
  55         return $sid if $sid;
  56     }
  57     $c->maybe::next::method(@_);
  58 }
  59
  60 sub set_session_id {
  61     my ( $c, $sid ) = @_;
  62     $c->_set_session(id => $sid);
  63     $c->maybe::next::method($sid);
  64 }
  65
  66 sub get_session_expires {
  67     my $c = shift;
  68     my $session = $c->_get_session;
  69     defined $session->{expires} ? $session->{expires} : undef;
  70 }
  71
  72 sub set_session_expires {
  73     my ( $c, $expires ) = @_;
  74
  75     $c->_set_session(expires => time() + $expires);
  76     $c->maybe::next::method($expires)
  77 }
  78
  79 sub delete_session_id {
  80     my ($c, $sid ) = @_;
  81     $c->_deleted_session_id(1);
  82     #Empty the tip
  83     %{$c->_get_session} = ();
  84     $c->maybe::next::method($sid);
  85 }
  86
  87
  88 1;
  89 __END__
  90
  91 =pod
  92
  93 =head1 NAME
  94
  95 Catalyst::Plugin::Session::State::Stash - Maintain session IDs using the stash
  96
  97 =head1 SYNOPSIS
  98
  99  use Catalyst qw/Session Session::State::Stash Session::Store::Foo/;
 100
 101 =head1 DESCRIPTION
 102
 103 An alternative state storage plugin that allows you some more flexibility in
 104 dealing with session storage. This plugin loads and saves the session ID from
 105 and to the stash.
 106
 107 =head1 METHODS
 108
 109 =over 4
 110
 111 =item delete_session_id
 112
 113 Deletes the session. Unfortunately I've been unable to squash a bug that will
 114 stop you from opening a new session in the same execution, however.
 115 Patches welcome!
 116
 117 =item get_session_id
 118
 119 Gets the current session id.
 120
 121 =item set_session_id
 122
 123 Sets the session id to the C<shift>.
 124
 125 =item get_session_expires
 126
 127 Gets when the current session expires.
 128
 129 =item set_session_expires
 130
 131 Sets how many seconds from now the session should expire.
 132
 133 =back
 134
 135 =head1 EXTENDED METHODS
 136
 137 =over 4
 138
 139 =item prepare_action
 140
 141 Loads the id off the stash.
 142
 143 =item setup_session
 144
 145 Defaults the C<stash_key> parameter to C<_session>.
 146
 147 =back
 148
 149 =head1 CONFIGURATION
 150
 151 =over 4
 152
 153 =item stash_key
 154
 155 The name of the hash key to use. Defaults to C<_session>.
 156
 157 =item stash_delim
 158
 159 If present, splits stash_key at this character to nest. E.g. delim of '/'
 160 and key of '123/456' will store it as $c->stash->{123}->{456}
 161
 162 =item expires
 163
 164 How long the session should last in seconds.
 165
 166 =back
 167
 168 For example, you could stick this in MyApp.pm:
 169
 170   __PACKAGE__->config( session => {
 171      stash_key  => 'session_id',
 172   });
 173
 174 =head1 BUGS
 175
 176 You can't delete a session then create a new one. If this is important to you,
 177 patches welcome. It is not important to me and fixing this for completeness
 178 is pretty low on my list of priorities.
 179
 180 =head1 CAVEATS
 181
 182 Manual work may be involved to make better use of this.
 183
 184 If you are writing a stateful web service with
 185 L<Catalyst::Plugin::Server::XMLRPC>, you will probably only have to deal with
 186 loading, as when saving, the ID will already be on the stash.
 187
 188 =head1 SEE ALSO
 189
 190 L<Catalyst>, L<Catalyst::Plugin::Session>, L<Catalyst::Plugin::Session::State>,
 191 L<Catalyst::Plugin::Session::State::Cookie> (what you probably want).
 192
 193 =head1 AUTHORS
 194
 195 James Laver E<lt>perl -e 'printf qw/%s@%s.com cpan jameslaver/'E<gt>
 196
 197 =head1 CONTRIBUTORS
 198
 199 This module is derived from L<Catalyst::Plugin::Session::State::Cookie> code.
 200
 201 Thanks to anyone who wrote code for that.
 202
 203 Thanks to Kent Fredric for a patch for nested keys
 204
 205 =head1 COPYRIGHT
 206
 207 This program is free software, you can redistribute it and/or modify it
 208 under the same terms as Perl itself.
 209
 210 =cut
 211
 212 1;