Catalyst::Plugin::Session::Store::BerkeleyDB - store sessions in a berkeleydb

Catalyst-Plugin-Session-Store-BerkeleyDB documentation Contained in the Catalyst-Plugin-Session-Store-BerkeleyDB distribution.

Index

Code Index:

NAME

Top

Catalyst::Plugin::Session::Store::BerkeleyDB - store sessions in a berkeleydb

SYNOPSIS

Top

    package YourApp;
    use Catalyst qw/Session Session::State::Cookie Session::Store::BerkeleyDB/;

DESCRIPTION

Top

This module will store Catalyst sessions in a Berkeley database managed by BerkeleyDB::Manager. Unlike other storage mechanisms, sessions are never lost before their expiration time.

To cleanup old sessions, you might want to make sure $c->delete_expired_sessions is run periodically.

CONFIGURATION

Top

You can configure this module in a number of ways. By default, the module will create a Berkeley database called "catalyst_sessions" in a directory called "sessions" in your app's temp directory.

You can customize this, though, by setting the values of the "manager" and "database" keys in $c->config->{'Plugin::Session'}.

The manager key can be either an instance of BerkeleyDB::Manager, or it can be a hash to pass to the constructor of BerkeleyDB::Manager. (Or it can be empty, and we will use sane defaults.)

The database key can be the result of $manager->open_db( ... ), or it can be a string naming the database. By default, we use "catalyst_sessions".

Any other keys in the hash will be ignored by this module, but might be relevant to other session plugins.

CONTRIBUTING

Top

Patches welcome!

You can get a copy of the repository by running:

  $ git clone git://git.jrock.us/Catalyst-Plugin-Session-Store-BerkeleyDB

and you can view the repository in your web browser at:

http://git.jrock.us/?p=Catalyst-Plugin-Session-Store-BerkeleyDB.git;a=summary

SEE ALSO

Top

BerkeleyDB

BerkeleyDB::Manager

AUTHOR

Top

Jonathan Rockway <jrockway@cpan.org>

COPYRIGHT

Top

Copyright (c) 2008 Infinity Interactive. This module is free software, you may distribute it under the same terms as Perl itself.

Catalyst-Plugin-Session-Store-BerkeleyDB documentation Contained in the Catalyst-Plugin-Session-Store-BerkeleyDB distribution. 
package Catalyst::Plugin::Session::Store::BerkeleyDB;
use strict;
use warnings;

use MRO::Compat;
use BerkeleyDB;
use BerkeleyDB::Manager;
use Storable qw(nfreeze thaw);
use Scalar::Util qw(blessed);
use Catalyst::Utils;
use Carp qw(confess);

use namespace::clean;

our $VERSION = '0.04';

use base 'Class::Data::Inheritable', 'Catalyst::Plugin::Session::Store';

my $_manager = '_session_store_manager';
my $_db = '_session_store_database';

__PACKAGE__->mk_classdata($_manager);
__PACKAGE__->mk_classdata($_db);

sub setup_session {
    my $app = shift;

    my $manager = delete $app->_session_plugin_config->{manager} || +{
        home => Path::Class::Dir->new(
            Catalyst::Utils::class2tempdir($app), 'sessions',
        ),
        create => 1,
    };

    my $db = delete $app->_session_plugin_config->{database} || 'catalyst_sessions';

    if(!blessed $manager){
        $manager = BerkeleyDB::Manager->new( $manager );
    }

    if(!blessed $db){
        $db = $manager->open_db( $db );
    }

    $app->$_manager($manager);
    $app->$_db($db);

    return $app->maybe::next::method(@_);
}

sub _data_is_raw {
    my ($c, $id, $data) = @_;
    return 1 if $id =~ /^expires:/;
    return 0;
}

sub get_session_data {
    my ($c, $id) = @_;

    my $data;
    $c->$_manager->txn_do(sub {
        my $status = $c->$_db->db_get($id, $data);

        confess "BerkeleyDB error while fetching data: $BerkeleyDB::Error ($status)"
          if $status && $status != DB_NOTFOUND;
    });

    if($data) {
        if($c->_data_is_raw($id)){
            return $data;
        }
        return thaw($data);
    }
    return {};
}

sub store_session_data {
    my ($c, $id, $data) = @_;
    my $frozen = $c->_data_is_raw($id) ? $data : nfreeze($data);
    $c->$_manager->txn_do(sub {
        $c->$_db->db_put($id, $frozen);
    });
}

sub delete_session_data {
    my ($c, $id) = @_;
    $c->$_manager->txn_do(sub {
        $c->$_db->db_del($id);
    });
}

sub delete_expired_sessions {
    my($c, $id) = @_;
    my $manager = $c->$_manager;
    my $db = $c->$_db;

    $manager->txn_do(sub {
        my ($key, $value) = ("", "");

        # find out what we need to delete
        my %to_delete;
        my $all = $db->db_cursor;
        while( 0 == $all->c_get( $key, $value, DB_NEXT ) ){
            if($key =~ /^expires:(.+)$/){
                $to_delete{$1} = 1 if time > $value;
            }
        }

        # then delete all of those
        $all = $db->db_cursor;
        while( 0 == $all->c_get( $key, $value, DB_NEXT ) ){
            my ($name, $id) = split /:/, $key;
            $all->c_del() and warn "bye, $key" if $to_delete{$id};
        };
    });
}

1;

__END__