view release on metacpan or  search on metacpan

lib/Catalyst/Authentication/Store/CouchDB/User.pm  view on Meta::CPAN

## no critic
# no critic line turns off Perl::Critic, to get rid of the warning that
# Dist::Zilla::Plugin::PkgVersion puts the package version straight
package Catalyst::Authentication::Store::CouchDB::User;
BEGIN {
  $Catalyst::Authentication::Store::CouchDB::User::VERSION = '0.001';
}
# ABSTRACT: The backing user class for the Catalyst::Authentication::Store::CouchDB storage module.
## use critic
use strict;
use warnings;

use Moose 2.000;
use MooseX::NonMoose 0.20;
use CouchDB::Client 0.09 qw ();
use Catalyst::Exception;
use Catalyst::Utils;
use JSON 2.17 qw ();
use Try::Tiny 0.09;


use namespace::autoclean;
extends 'Catalyst::Authentication::User';

has '_user'         => (is => 'rw', isa => 'CouchDB::Client::Doc', );
has '_couchdb'      => (is => 'ro', isa => 'CouchDB::Client::DB', );
has '_designdoc'    => (is => 'ro', isa => 'CouchDB::Client::DesignDoc', );
has 'view'          => (is => 'ro', isa => 'Str', required => 1, );

around BUILDARGS => sub {
    my ($orig, $class, $config, $c) = @_;

    # Allow the User Agent to be overridden - this is handy for tests to 
    # mock up the CouchDB interaction

    my $ua_class = (exists $config->{ua} ? $config->{ua} : 'LWP::UserAgent');
    Catalyst::Utils::ensure_class_loaded($ua_class);
    my $ua = $ua_class->new();

    my $couch = CouchDB::Client->new(
        uri => $config->{couchdb_uri},
        ua  => $ua,
    );

    if (!$couch->testConnection()) {
        Catalyst::Exception->throw("Could not connect to database");
    }

    my $couch_database = $couch->newDB($config->{dbname});
    my $couch_designdoc = try {
        $couch_database->newDesignDoc($config->{designdoc})->retrieve();
    };
    if (!$couch_designdoc) {
        Catalyst::Exception->throw("Could not retrieve design document");
    };

    if (!exists $couch_designdoc->views->{$config->{view}}) {
        Catalyst::Exception->throw("Design document does not contain view");
    }

    return $class->$orig(
        _couchdb    => $couch_database,
        _designdoc  => $couch_designdoc,
        view        => $config->{view},
    );

};


sub load {
    my ($self, $authinfo, $c) = @_;

    my $couch_data = try { $self->_designdoc->queryView(
            $self->view,
            include_docs    => 'true',
            limit           => 1,
            key             => $authinfo->{username},
        );
    };