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 =head1 NAME
   9
  10 DBIx::Class::Storage::DBI::NoBindVars - Sometime DBDs have poor to no support for bind variables
  11
  12 =head1 DESCRIPTION
  13
  14 This class allows queries to work when the DBD or underlying library does not
  15 support the usual C<?> placeholders, or at least doesn't support them very
  16 well, as is the case with L<DBD::Sybase>
  17
  18 =head1 METHODS
  19
  20 =head2 sth
  21
  22 Uses C<prepare> instead of the usual C<prepare_cached>, seeing as we can't cache very effectively without bind variables.
  23
  24 =cut
  25
  26 sub sth {
  27   my ($self, $sql) = @_;
  28   return $self->dbh->prepare($sql);
  29 }
  30
  31 =head2 _execute
  32
  33 Manually subs in the values for the usual C<?> placeholders before calling L</sth> on the generated SQL.
  34
  35 =cut
  36
  37 sub _execute {
  38   my ($self, $op, $extra_bind, $ident, @args) = @_;
  39   my ($sql, @bind) = $self->sql_maker->$op($ident, @args);
  40   unshift(@bind, @$extra_bind) if $extra_bind;
  41   if ($self->debug) {
  42     my @debug_bind = map { defined $_ ? qq{'$_'} : q{'NULL'} } @bind;
  43     $self->debugobj->query_start($sql, @debug_bind);
  44   }
  45
  46   while(my $bvar = shift @bind) {
  47     $bvar = $self->dbh->quote($bvar);
  48     $sql =~ s/\?/$bvar/;
  49   }
  50
  51   my $sth = eval { $self->sth($sql,$op) };
  52
  53   if (!$sth || $@) {
  54     $self->throw_exception(
  55       'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql"
  56     );
  57   }
  58
  59   my $rv;
  60   if ($sth) {
  61     my $time = time();
  62     $rv = eval { $sth->execute };
  63
  64     if ($@ || !$rv) {
  65       $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr));
  66     }
  67   } else {
  68     $self->throw_exception("'$sql' did not generate a statement.");
  69   }
  70   if ($self->debug) {
  71     my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
  72     $self->debugobj->query_end($sql, @debug_bind);
  73   }
  74   return (wantarray ? ($rv, $sth, @bind) : $rv);
  75 }
  76
  77 =head1 AUTHORS
  78
  79 Brandon Black <blblack@gmail.com>
  80
  81 Trym Skaar <trym@tryms.no>
  82
  83 =head1 LICENSE
  84
  85 You may distribute this code under the same terms as Perl itself.
  86
  87 =cut
  88
  89 1;