—
—

              
package Catalyst::Plugin::Session::Store::Couchbase;
use Moose;
use MRO::Compat;
extends 'Catalyst::Plugin::Session::Store';
with 'Catalyst::ClassData';
use Catalyst::Exception;
use Couchbase::Bucket;
use Couchbase::Document;
use namespace::clean -except => 'meta'; # The last bit cargo culted.
use Storable qw(nfreeze thaw);
use URI::Escape qw(uri_escape);
our $VERSION = '0.94';
__PACKAGE__->mk_classdata('_session_cb_bucket_handle');
__PACKAGE__->mk_classdata('_session_couchbase_prefix');
HideShow 56 lines of Pod
=head1 NAME
Catalyst::Plugin::Session::Store::Couchbase
=head1 SYNOPSIS
  use Catalyst qw{Session Session::Store::Couchbase Session::State::Cookie};
  MyApp->config(
    'Plugin::Session' => {
      expires => 7200,
      couchbase_server =>  'couchbase01.domain',
      couchbase_password => 'password',
      couchbase_bucket => 'default',
      couchbase_ssl => 1,
      couchbase_certpath => '/example/certpath/cert.pem',
    },
  );
=head1 CONFIG OPTIONS
=over 4
=item couchbase_server
The Couchbase server to connect to. If there are multiple nodes in a cluster,
multiple servers can be provided as a comma-delimited list (ex: host1,host2),
which can improve reliability if the primary connection node is down. If the
cluster is responding on a different port, it may be provided as host:port,
where port is the memcached listening port.
=item couchbase_password
Password for the given bucket. This can be omitted if a password is not set on
the given bucket.
=item couchbase_bucket
Bucket name to connect to. Defaults to "default" if it is not provided.
=item couchbase_ssl
Set to 1 if the cluster is SSL-enabled and a SSL connection is desired. SSL
support requires Couchbase Server 2.5 or higher and a copy of the server's
SSL certificate. Defaults to off.
=item couchbase_certpath
Path to the server's SSL pem-encoded certificate for validation. Not required if
SSL is disabled.
=item couchbase_timeout
Timeout (in seconds) to allow for bootstrapping a client. Defaults to 6.
=cut
sub setup_session {
    my $c = shift;
    $c->maybe::next::method(@_);
    $c->log->debug("Setting up Couchbase session store") if $c->debug;
    my $session_cfg = $c->config->{'Plugin::Session'};
    # Lift up old configuration format
    if ( $c->config->{Couchbase} and not $session_cfg->{couchbase_server} ) {
        foreach my $k ( keys %{$c->config->{Couchbase}} ) {
            $session_cfg->{ 'couchbase_' . $k } = $c->config->{Couchbase}->{$k};
        }
    }
    # Shorten names
    my $cfg = {
        map { my $k = $_; $k =~ s/^couchbase_//; $k => $session_cfg->{$_} } keys %{ $session_cfg }
    };
    my $appname = "$c";
    $c->_session_couchbase_prefix($appname . "sess:");
    my $connection_url = _build_couchbase_url($cfg);
    my $bucket = Couchbase::Bucket->new($connection_url);
    Catalyst::Exception->throw("Couchbase bucket object undefined!")
        unless defined $bucket;
    $c->_session_cb_bucket_handle($bucket);
    return 1;
}
sub get_session_data {
    my ($c, $key) = @_;
    croak("No cache key specified") unless length($key);
    my ( $type, $id ) = split( ':', $key );
    $key = $c->_session_couchbase_prefix . $id;
    my $doc = Couchbase::Document->new($key);
    $c->_session_cb_bucket_handle->get_and_touch($doc);
    if (defined $doc and $doc->is_ok and defined $doc->value) {
        return $doc->value->{$type};
    }
    elsif (defined $doc) {
        my $err = $doc->errstr;
        Catalyst::Exception->throw(
            "Failed to fetch Couchbase item: $err. Key was: $key"
        ) unless $err =~ /key does not exist/;
    }
    return;
}
sub store_session_data {
    my ($c, $key, $data) = @_;
    croak("No cache key specified") unless length($key);
    my ( $type, $id ) = split( ':', $key );
    $key = $c->_session_couchbase_prefix . $id;
    my $expiry = $c->session_expires ? $c->session_expires - time() : 0;
    if (not $expiry) {
        $c->log->warn("No expiry set for sessions! Defaulting to one hour..");
        $expiry = 3600;
    }
    my $doc = Couchbase::Document->new($key);
    $c->_session_cb_bucket_handle->get($doc);
    if ($doc->is_ok) {
        $doc->value->{$type} = $data;
        $doc->expiry($expiry);
        $c->_session_cb_bucket_handle->replace($doc);
    } else {
        $doc = Couchbase::Document->new( $key, {} );
        $doc->value->{$type} = $data;
        $doc->expiry($expiry);
        $c->_session_cb_bucket_handle->insert($doc);
    }
    unless ($doc->is_ok) {
        Catalyst::Exception->throw(
            "Couldn't save $key / $data in couchbase storage: " . $doc->errstr
        );
    }
    return 1;
}
sub delete_session_data {
    my ($c, $key) = @_;
    $c->log->debug("Couchbase session store: delete_session_data($key)") if $c->debug;
    croak("No cache key specified") unless length($key);
    my ( $type, $id ) = split( ':', $key );
    $key = $c->_session_couchbase_prefix . $id;
    my $doc = Couchbase::Document->new($key);
    $c->_session_cb_bucket_handle->remove($doc);
    return 1;
}
# Not required as Couchbase expires things itself.
sub delete_expired_sessions { }
# Build a Couchbase connection string
sub _build_couchbase_url {
    my ($cfg) = @_;
    # Set timeout to 6 seconds
    my %options = (
        config_node_timeout => ( $cfg->{timeout} or 6 ) * 1_000_000,
    );
    # Connection URL is couchbases?://host1,host2/bucket?options
    Catalyst::Exception->throw(
        'Missing Couchbase server'
    ) unless $cfg->{server};
    my $connection_url = join('/',
        ':/',
        $cfg->{server},
        ( $cfg->{bucket} or 'default' ),
    );
    $options{password} = $cfg->{password} if ($cfg->{password});
    if ($cfg->{ssl}) {
        if (not $cfg->{certpath} or not -e $cfg->{certpath}) {
            Catalyst::Exception->throw(
                'SSL enabled, but certpath is missing or invalid'
            );
        }
        $connection_url = 'couchbases' . $connection_url;
        $options{certpath} = $cfg->{certpath};
    } else {
        $connection_url = 'couchbase' . $connection_url;
    }
    $connection_url .= '?' . join(
        '&', ( map { $_ . '=' . uri_escape($options{$_}) } keys %options )
    );
    return $connection_url;
}
HideShow 60 lines of Pod
=head1 AUTHORS
=over 4
=item Toby Corkindale, C<< <tjc at wintrmute.net> >>
=item Nick Melnick C<< <nick at abstractwankery.com> >>
=back
=head1 BUGS
Please report any bugs to the Github repo for this module:
https://github.com/nmelnick/Catalyst-Plugin-Session-Store-Couchbase
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
    perldoc Catalyst::Plugin::Session::Store::Couchbase
You can also look for information at:
=over 4
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/Catalyst-Plugin-Session-Store-Couchbase>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/Catalyst-Plugin-Session-Store-Couchbase>
=item * Search CPAN
L<http://search.cpan.org/dist/Catalyst-Plugin-Session-Store-Couchbase/>
=back
=head1 ACKNOWLEDGEMENTS
This module was supported by Strategic Data. The module was originally
written for their internal use, and the company has allowed me to produce
an open-source version.
=head1 LICENSE AND COPYRIGHT
Copyright 2013-14 Toby Corkindale, Nick Melnick.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
__PACKAGE__->meta->make_immutable;
1;