X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FNoBindVars.pm;h=95f1cac94222b9df12a10dc429e7ae156c701326;hb=e6d6286068a0c2cba2e7026cfdddfbeb512a0770;hp=73c7b43b4f3e63cff43d309b25e1072d13017cd9;hpb=7762b22c04ef25c6dd2d2bc86abeb90394abf193;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/NoBindVars.pm b/lib/DBIx/Class/Storage/DBI/NoBindVars.pm index 73c7b43..95f1cac 100644 --- a/lib/DBIx/Class/Storage/DBI/NoBindVars.pm +++ b/lib/DBIx/Class/Storage/DBI/NoBindVars.pm @@ -4,64 +4,71 @@ use strict; use warnings; use base 'DBIx::Class::Storage::DBI'; +use mro 'c3'; -sub _execute { - my ($self, $op, $extra_bind, $ident, @args) = @_; - my ($sql, @bind) = $self->sql_maker->$op($ident, @args); - unshift(@bind, @$extra_bind) if $extra_bind; - if ($self->debug) { - my @debug_bind = map { defined $_ ? qq{'$_'} : q{'NULL'} } @bind; - $self->debugobj->query_start($sql, @debug_bind); - } +=head1 NAME - while(my $bvar = shift @bind) { - $bvar = $self->dbh->quote($bvar); - $sql =~ s/\?/$bvar/; - } +DBIx::Class::Storage::DBI::NoBindVars - Sometime DBDs have poor to no support for bind variables - my $sth = eval { $self->sth($sql,$op) }; +=head1 DESCRIPTION - if (!$sth || $@) { - $self->throw_exception( - 'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql" - ); - } +This class allows queries to work when the DBD or underlying library does not +support the usual C placeholders, or at least doesn't support them very +well, as is the case with L - my $rv; - if ($sth) { - my $time = time(); - $rv = eval { $sth->execute }; +=head1 METHODS - if ($@ || !$rv) { - $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr)); - } - } else { - $self->throw_exception("'$sql' did not generate a statement."); - } - if ($self->debug) { - my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind; - $self->debugobj->query_end($sql, @debug_bind); - } - return (wantarray ? ($rv, $sth, @bind) : $rv); +=head2 connect_info + +We can't cache very effectively without bind variables, so force the C setting to be turned on when the connect info is set. + +=cut + +sub connect_info { + my $self = shift; + my $retval = $self->next::method(@_); + $self->disable_sth_caching(1); + $retval; } -1; +=head2 _prep_for_execute -=head1 NAME +Manually subs in the values for the usual C placeholders. -DBIx::Class::Storage::DBI::NoBindVars - Sometime DBDs have poor to no support for bind variables +=cut -=head1 SYNOPSIS +sub _prep_for_execute { + my $self = shift; -=head1 DESCRIPTION + my ($op, $extra_bind, $ident) = @_; -This class allows queries to work when the DBD or underlying library does not -support the usual C placeholders, or at least doesn't support them very -well, as is the case with L + my ($sql, $bind) = $self->next::method(@_); + + # stringify args, quote via $dbh, and manually insert + + my @sql_part = split /\?/, $sql; + my $new_sql; + + foreach my $bound (@$bind) { + my $col = shift @$bound; + my $datatype = 'FIXME!!!'; + foreach my $data (@$bound) { + if(ref $data) { + $data = ''.$data; + } + $data = $self->_dbh->quote($data); + $new_sql .= shift(@sql_part) . $data; + } + } + $new_sql .= join '', @sql_part; + + return ($new_sql, []); +} =head1 AUTHORS Brandon Black + Trym Skaar =head1 LICENSE @@ -69,3 +76,5 @@ Trym Skaar You may distribute this code under the same terms as Perl itself. =cut + +1;