lib/DBIx/Class/Storage/DBI/NoBindVars.pm

   1 package DBIx::Class::Storage::DBI::NoBindVars;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base 'DBIx::Class::Storage::DBI';
   7
   8 sub _execute {
   9   my ($self, $op, $extra_bind, $ident, @args) = @_;
  10   my ($sql, @bind) = $self->sql_maker->$op($ident, @args);
  11   unshift(@bind, @$extra_bind) if $extra_bind;
  12   if ($self->debug) {
  13     my @debug_bind = map { defined $_ ? qq{'$_'} : q{'NULL'} } @bind;
  14     $self->debugobj->query_start($sql, @debug_bind);
  15   }
  16
  17   while(my $bvar = shift @bind) {
  18     $bvar = $self->_dbh->quote($bvar);
  19     $sql =~ s/\?/$bvar/;
  20   }
  21
  22   my $sth = eval { $self->sth($sql,$op) };
  23
  24   if (!$sth || $@) {
  25     $self->throw_exception(
  26       'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql"
  27     );
  28   }
  29
  30   my $rv;
  31   if ($sth) {
  32     my $time = time();
  33     $rv = eval { $sth->execute };
  34
  35     if ($@ || !$rv) {
  36       $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr));
  37     }
  38   } else {
  39     $self->throw_exception("'$sql' did not generate a statement.");
  40   }
  41   if ($self->debug) {
  42     my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
  43     $self->debugobj->query_end($sql, @debug_bind);
  44   }
  45   return (wantarray ? ($rv, $sth, @bind) : $rv);
  46 }
  47
  48 1;
  49
  50 =head1 NAME
  51
  52 DBIx::Class::Storage::DBI::NoBindVars - Sometime DBDs have poor to no support for bind variables
  53
  54 =head1 SYNOPSIS
  55
  56 =head1 DESCRIPTION
  57
  58 This class allows queries to work when the DBD or underlying library does not
  59 support the usual C<?> placeholders, or at least doesn't support them very
  60 well, as is the case with L<DBD::Sybase>
  61
  62 =head1 AUTHORS
  63
  64 Brandon Black <blblack@gmail.com>
  65 Trym Skaar <trym@tryms.no>
  66
  67 =head1 LICENSE
  68
  69 You may distribute this code under the same terms as Perl itself.
  70
  71 =cut