1#*********************************************************************
2#*** lib/ResourcePool/Command/DBI/Common.pm
3#*** Copyright (c) 2004 by Markus Winand <mws@fatalmind.com>
4#*** $Id: Common.pm,v 1.3 2004/05/02 07:48:55 mws Exp $
5#*********************************************************************
6package ResourcePool::Command::DBI::Common;
7
8use ResourcePool::Command;
9use ResourcePool::Command::NoFailoverException;
10use strict;
11use DBI;
12use vars qw($VERSION);
13
14$VERSION = "1.0101";
15
16sub new($$;$@) {
17	my $proto = shift;
18	my $class = ref($proto) || $proto;
19	my $self  = {};
20	my $sql   = shift;
21
22	bless($self, $class);
23	$self->_setOptions({});
24
25	if (defined $sql && $sql ne '') {
26		if (scalar(@_) == 0 || ref($_[0]) eq 'HASH' || scalar(@_) %2 == 0) {
27			# if these things are given, the first argument is a SQL
28			$self->_setSQL($sql);
29
30			if (defined $_[0]) {
31				if (ref($_[0]) eq 'HASH') {
32					$self->_setBindArgs(shift);
33					if (defined $_[0]) {
34						$self->_setOptions({@_});
35					}
36				} else {
37					$self->_setOptions({@_});
38				}
39			}
40		} else {
41			# otherwise, its part of an option
42			$self->_setOptions({($sql, @_)});
43		}
44
45	}
46
47	return $self;
48}
49
50sub _setSQL($$) {
51	my ($self, $sql) = @_;
52	$self->{sql} = $sql;
53}
54
55sub getSQL($) {
56	my ($self) = @_;
57	return $self->{sql};
58}
59
60sub _setBindArgs($$) {
61	my ($self, $bindargs) = @_;
62	$self->{bindargs} = $bindargs;
63}
64sub _getBindArgs($) {
65	my ($self, $sql) = @_;
66	return $self->{bindargs};
67}
68
69sub _setOptions($$) {
70	my ($self, $options) = @_;
71	# the defaults
72	my %options = (
73		prepare_cached => 0
74	);
75	%options = ((%options), %{$options});
76	$self->{options} = \%options;
77}
78
79sub _getOptions($) {
80	my ($self) = @_;
81	return $self->{options};
82}
83
84sub _getOptPrepareCached($) {
85	my ($self) = @_;
86	return $self->{options}->{prepare_cached};
87}
88
89sub getSQLfromargs($$) {
90	my ($self, $argsref) = @_;
91	my $sql = $self->getSQL();
92
93	if (! defined $sql && ! ref($argsref->[0])) {
94		$sql = shift @{$argsref};
95	}
96
97	if (! defined $sql) {
98		die ResourcePool::Command::NoFailoverException->new(
99			ref($self) . ': '
100			. 'you have to specify a SQL statement'
101		);
102	}
103	return $sql;
104}
105
106sub prepare($$) {
107	my ($self, $dbh, $sql) = @_;
108	my $sth;
109
110	if ($self->_getOptPrepareCached()) {
111		$sth = $dbh->prepare_cached($sql);
112	} else {
113		$sth = $dbh->prepare($sql);
114	}
115
116	return $sth;
117}
118
119sub bind($$) {
120	my ($self, $sth, $argsref) = @_;
121
122	if (scalar(@{$argsref}) > 0) {
123		my $argshash;
124		if (ref($argsref->[0]) eq 'HASH') {
125			# named args syntax
126			$argshash = $argsref->[0];
127		} else {
128			# ordered args syntax
129			my %argshash;
130			$argshash = {};
131			my $arg;
132			my $i = 1;
133			foreach $arg (@{$argsref}) {
134				$argshash{$i} = $arg;
135				++$i;
136			}
137			$argshash = \%argshash;
138		}
139
140		# bind parameters
141		my $bindargs = $self->_getBindArgs();
142		my ($name);
143		foreach $name (keys(%{$argshash})) {
144			if (defined $bindargs->{$name}->{max_len}) {
145				# in that case, $value is required to be a ref
146				$sth->bind_param_inout($name
147					, $argshash->{$name}
148					, $bindargs->{$name}->{max_len}
149					, $bindargs->{$name}->{type}
150				);
151			} else {
152				$sth->bind_param($name
153					, $argshash->{$name}
154					, $bindargs->{$name}->{type});
155			}
156		}
157	}
158}
159
160sub info($) {
161	my ($self) = @_;
162	my $sql = $self->getSQL();
163	if (defined $sql) {
164		return ref($self) . ": '" . $sql . "'";
165	} else {
166		return ref($self) . ": no SQL pre-declared";
167	}
168}
169
170
1711;
172