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';


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 );


    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) {
            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 {

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};



=head1 NAME

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


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


This module will store Catalyst sessions in a Berkeley database
managed by C<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<< $c->delete_expired_sessions >> is run periodically.


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<< $c->config->{'Plugin::Session'} >>.

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

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

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


Patches welcome!

You can get a copy of the repository by running:

  $ git clone git://

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


=head1 SEE ALSO



=head1 AUTHOR

Jonathan Rockway C<< <> >>


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