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