File Coverage

blib/lib/Rose/DBx/CannedQuery.pm

Criterion	Covered	Total	%
statement	31	85	36.4
branch	4	32	12.5
condition	1	8	12.5
subroutine	10	19	52.6
pod	6	6	100.0
total	52	150	34.6

#!perl
#

use strict;
use warnings;

package Rose::DBx::CannedQuery;

our ($VERSION) = '1.00';

use Carp;
use Scalar::Util;

use Moo 2;
use Rose::DB;    # Marker for prerequisite
use Types::Standard qw/ Str HashRef InstanceOf Object /;

has 'sql' => ( is => 'ro', isa => Str, required => 1 );

has 'rdb_class' => (
    is       => 'ro',
    isa      => Str,
    required => 0,
    lazy     => 1,
    builder  => '_retcon_rdb_class'
);

sub _retcon_rdb_class {
    my $self = shift;
    Carp::croak "Can't recover Rose::DB class information without a handle"
      unless $self->_has_rdb;  # Use predicate to avoid recursion with _init_rdb
    my $class = Scalar::Util::blessed $self->rdb;

    # Ugly hack
    # Rose::DB creates handles in private classes; this may fail in the
    # future, as it relies on undocumented Rose::DB behavior
    $class =~ s/::__RoseDBPrivate__.*$//;
    return $class;
}

has 'rdb_params' => (
    is       => 'ro',
    isa      => HashRef,
    required => 0,
    lazy     => 1,
    builder  => '_retcon_rdb_params'
);

sub _retcon_rdb_params {
    my $self = shift;
    Carp::croak "Can't recover Rose::DB datasource information without a handle"
      unless $self->_has_rdb;  # Use predicate to avoid recursion with _init_rdb
    my $rdb = $self->rdb;
    return { type => $rdb->type, domain => $rdb->domain };
}

has 'rdb' => (
    is        => 'ro',
    isa       => InstanceOf ['Rose::DB'],
    required  => 0,
    lazy      => 1,
    predicate => '_has_rdb',
    builder   => '_init_rdb',
    handles   => ['dbh']
);

sub _default_rdb_params {
    return {
        connect_options => {
            RaiseError => 1,
            PrintError => 0,
            AutoCommit => 1
        }
    };
}

sub _init_rdb {
    my $self  = shift;
    my $class = $self->rdb_class;
    defined $class and eval "$class->can('new_or_cached') || require $class"
      or Carp::croak "Failed to load class $class: $@";
    return $self->rdb_class->new_or_cached( %{ $self->_default_rdb_params },
        %{ $self->rdb_params } );
}

has 'sth' => (
    is       => 'ro',
    isa      => Object,       # DBI's sth class is private
    required => 0,
    init_arg => undef,
    lazy     => 1,
    builder  => '_init_sth'
);

sub setup_dbh_for_query {
    my ($self) = @_;
    my $dbh = $self->rdb->dbh;
    $dbh->{FetchHashKeyName} = 'NAME_lc';
    return $dbh;
}

sub _init_sth {
    my $self = shift;
    my $dbh  = $self->setup_dbh_for_query;
    my $sth  = $dbh->prepare( $self->sql );
    unless ($sth) {
        Carp::croak 'Error preparing query: '
          . $dbh->errstr
          . "\nSQL was:\n\t"
          . join( "\n\t", split( /\n/, $self->sql ) ) . "\n";
        return;
    }
    return $sth;
}

sub execute {
    my ( $self, @args ) = @_;
    my $sth = $self->sth;

    unless ( $sth->execute(@args) ) {
        Carp::croak 'Error executing query: '
          . $sth->errstr
          . "\nArguments were:\n\t"
          . join( "\n\t", @args ) . "\n";
        return;
    }
    return $sth;
}

sub resultref {
    my ( $self, $args, $opts ) = @_;
    $opts ||= [ {} ];
    my $sth = $self->execute( @{ $args || [] } );
    return $sth->fetchall_arrayref(@$opts);
}

sub results {
    my ( $self, @args ) = @_;
    return @{ $self->resultref( \@args ) };
}

sub BUILDARGS {
    my ( $self, @args ) = @_;
    my $canon = $self->SUPER::BUILDARGS(@args);
    if ( not exists $canon->{rdb} ) {
        unless ( exists $canon->{rdb_class} ) {
            Carp::croak
              'Need either Rose::DB object or information to construct one';
            return;
        }
    }
    return $canon;
}

# Simple class data - at least for now, the added dependency of
# MooX::ClassAttribute seems more weight than it's worth
{
    my $Query_cache;

    sub _query_cache {
        my $self = shift;

        Carp::croak("_query_cache() may only be set via a class method call")
          if ref $self and @_;

        if (@_) {
            $Query_cache->clear() if $Query_cache;
            $Query_cache = $_[0];
        }
        elsif ( not defined $Query_cache ) {
            require Rose::DBx::CannedQuery::SimpleQueryCache;
            $Query_cache = Rose::DBx::CannedQuery::SimpleQueryCache->new();
        }

        return $Query_cache;
    }
}

sub new_or_cached {
    my ( $self, @args ) = @_;
    my $args_for_cache_key = ref $args[0] ? $args[0] : {@args};
    @args = {@args} unless ref $args[0];
    my $query = $self->_query_cache->get_query_from_cache($args_for_cache_key);
    if ( not $query ) {
        $query = $self->new(@args);
        $self->_query_cache->add_query_to_cache( $query, $args_for_cache_key )
          if $query;
    }
    return $query;
}

1;

__END__