File Coverage

blib/lib/ResourcePool/Command/DBI/Common.pm

Criterion	Covered	Total	%
statement	49	90	54.4
branch	10	24	41.6
condition	9	15	60.0
subroutine	13	17	76.4
pod	0	6	0.0
total	81	152	53.2

#*********************************************************************
#*** lib/ResourcePool/Command/DBI/Common.pm
#*** Copyright (c) 2004 by Markus Winand
#*** $Id: Common.pm,v 1.3 2004/05/02 07:48:55 mws Exp $
#*********************************************************************
package ResourcePool::Command::DBI::Common;

use ResourcePool::Command;
use ResourcePool::Command::NoFailoverException;
use strict;
use DBI;
use vars qw($VERSION);

$VERSION = "1.0101";

sub new($$;$@) {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self  = {};
	my $sql   = shift;

	bless($self, $class);
	$self->_setOptions({});

	if (defined $sql && $sql ne '') {
		if (scalar(@_) == 0 || ref($_[0]) eq 'HASH' || scalar(@_) %2 == 0) {
			# if these things are given, the first argument is a SQL
			$self->_setSQL($sql);

			if (defined $_[0]) {
				if (ref($_[0]) eq 'HASH') {
					$self->_setBindArgs(shift);
					if (defined $_[0]) {
						$self->_setOptions({@_});
					}
				} else {
					$self->_setOptions({@_});
				}
			}
		} else {
			# otherwise, its part of an option
			$self->_setOptions({($sql, @_)});
		}

	}

	return $self;
}

sub _setSQL($$) {
	my ($self, $sql) = @_;
	$self->{sql} = $sql;
}

sub getSQL($) {
	my ($self) = @_;
	return $self->{sql};
}

sub _setBindArgs($$) {
	my ($self, $bindargs) = @_;
	$self->{bindargs} = $bindargs;
}
sub _getBindArgs($) {
	my ($self, $sql) = @_;
	return $self->{bindargs};
}

sub _setOptions($$) {
	my ($self, $options) = @_;
	# the defaults
	my %options = (
		prepare_cached => 0
	);
	%options = ((%options), %{$options});
	$self->{options} = \%options;
}

sub _getOptions($) {
	my ($self) = @_;
	return $self->{options};
}

sub _getOptPrepareCached($) {
	my ($self) = @_;
	return $self->{options}->{prepare_cached};
}

sub getSQLfromargs($$) {
	my ($self, $argsref) = @_;
	my $sql = $self->getSQL();

	if (! defined $sql && ! ref($argsref->[0])) {
		$sql = shift @{$argsref};
	}

	if (! defined $sql) {
		die ResourcePool::Command::NoFailoverException->new(
			ref($self) . ': '
			. 'you have to specify a SQL statement'
		);
	}
	return $sql;
}

sub prepare($$) {
	my ($self, $dbh, $sql) = @_;
	my $sth;

	if ($self->_getOptPrepareCached()) {
		$sth = $dbh->prepare_cached($sql);
	} else {
		$sth = $dbh->prepare($sql);
	}

	return $sth;
}

sub bind($$) {
	my ($self, $sth, $argsref) = @_;

	if (scalar(@{$argsref}) > 0) {
		my $argshash;
		if (ref($argsref->[0]) eq 'HASH') {
			# named args syntax
			$argshash = $argsref->[0];
		} else {
			# ordered args syntax
			my %argshash;
			$argshash = {};
			my $arg;
			my $i = 1;
			foreach $arg (@{$argsref}) {
				$argshash{$i} = $arg;
				++$i;
			}
			$argshash = \%argshash;
		}

		# bind parameters
		my $bindargs = $self->_getBindArgs();
		my ($name);
		foreach $name (keys(%{$argshash})) {
			if (defined $bindargs->{$name}->{max_len}) {
				# in that case, $value is required to be a ref
				$sth->bind_param_inout($name
					, $argshash->{$name}
					, $bindargs->{$name}->{max_len}
					, $bindargs->{$name}->{type}
				);
			} else {
				$sth->bind_param($name
					, $argshash->{$name}
					, $bindargs->{$name}->{type});
			}
		}
	}
}

sub info($) {
	my ($self) = @_;
	my $sql = $self->getSQL();
	if (defined $sql) {
		return ref($self) . ": '" . $sql . "'";
	} else {
		return ref($self) . ": no SQL pre-declared";
	}
}


1;