X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=816bcf7c6ba6276bfb3d47b78ed073c61708d350;hb=2ce08f975f976b1de7a8f4461c0fa052e77ee489;hp=c276f38ca3fe8701b51b7d6c975d494c8c2aa06c;hpb=c3af542ac1f57914b3e1045e1367d1b0be8409e5;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index c276f38..816bcf7 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -37,11 +37,12 @@ package # Hide from PAUSE
   DBIC::SQL::Abstract; # Would merge upstream, but nate doesn't reply :(
 
 use base qw/SQL::Abstract::Limit/;
+use Carp::Clan qw/^DBIx::Class/;
 
-# This prevents the caching of $dbh in S::A::L, I believe
 sub new {
   my $self = shift->SUPER::new(@_);
 
+  # This prevents the caching of $dbh in S::A::L, I believe
   # If limit_dialect is a ref (like a $dbh), go ahead and replace
   #   it with what it resolves to:
   $self->{limit_dialect} = $self->_find_syntax($self->{limit_dialect})
@@ -50,6 +51,58 @@ sub new {
   $self;
 }
 
+
+
+# Some databases (sqlite) do not handle multiple parenthesis
+# around in/between arguments. A tentative x IN ( ( 1, 2 ,3) )
+# is interpreted as x IN 1 or something similar.
+#
+# Since we currently do not have access to the SQLA AST, resort
+# to barbaric mutilation of any SQL supplied in literal form
+
+sub _strip_outer_paren {
+  my ($self, $arg) = @_;
+
+  return $self->_SWITCH_refkind ($arg, {
+    ARRAYREFREF => sub {
+      $$arg->[0] = __strip_outer_paren ($$arg->[0]);
+      return $arg;
+    },
+    SCALARREF => sub {
+      return \__strip_outer_paren( $$arg );
+    },
+    FALLBACK => sub {
+      return $arg
+    },
+  });
+}
+
+sub __strip_outer_paren {
+  my $sql = shift;
+
+  if ($sql and not ref $sql) {
+    while ($sql =~ /^ \s* \( (.*) \) \s* $/x ) {
+      $sql = $1;
+    }
+  }
+
+  return $sql;
+}
+
+sub _where_field_IN {
+  my ($self, $lhs, $op, $rhs) = @_;
+  $rhs = $self->_strip_outer_paren ($rhs);
+  return $self->SUPER::_where_field_IN ($lhs, $op, $rhs);
+}
+
+sub _where_field_BETWEEN {
+  my ($self, $lhs, $op, $rhs) = @_;
+  $rhs = $self->_strip_outer_paren ($rhs);
+  return $self->SUPER::_where_field_BETWEEN ($lhs, $op, $rhs);
+}
+
+
+
 # DB2 is the only remaining DB using this. Even though we are not sure if
 # RowNumberOver is still needed here (should be part of SQLA) leave the 
 # code in place
@@ -95,6 +148,9 @@ sub _find_syntax {
 
 sub select {
   my ($self, $table, $fields, $where, $order, @rest) = @_;
+  local $self->{having_bind} = [];
+  local $self->{from_bind} = [];
+
   if (ref $table eq 'SCALAR') {
     $table = $$table;
   }
@@ -106,8 +162,7 @@ sub select {
   @rest = (-1) unless defined $rest[0];
   die "LIMIT 0 Does Not Compute" if $rest[0] == 0;
     # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
-  local $self->{having_bind} = [];
-  my ($sql, @ret) = $self->SUPER::select(
+  my ($sql, @where_bind) = $self->SUPER::select(
     $table, $self->_recurse_fields($fields), $where, $order, @rest
   );
   $sql .= 
@@ -119,7 +174,7 @@ sub select {
     ) :
     ''
   ;
-  return wantarray ? ($sql, @ret, @{$self->{having_bind}}) : $sql;
+  return wantarray ? ($sql, @{$self->{from_bind}}, @where_bind, @{$self->{having_bind}}) : $sql;
 }
 
 sub insert {
@@ -167,13 +222,30 @@ sub _recurse_fields {
       } @$fields);
   } elsif ($ref eq 'HASH') {
     foreach my $func (keys %$fields) {
+      if ($func eq 'distinct') {
+        my $_fields = $fields->{$func};
+        if (ref $_fields eq 'ARRAY' && @{$_fields} > 1) {
+          die "Unsupported syntax, please use " . 
+              "{ group_by => [ qw/" . (join ' ', @$_fields) . "/ ] }" .
+              " or " .
+              "{ select => [ qw/" . (join ' ', @$_fields) . "/ ], distinct => 1 }";
+        }
+        else {
+          $_fields = @{$_fields}[0] if ref $_fields eq 'ARRAY';
+          carp "This syntax will be deprecated in 09, please use " . 
+               "{ group_by => '${_fields}' }" . 
+               " or " .
+               "{ select => '${_fields}', distinct => 1 }";
+        }
+      }
+      
       return $self->_sqlcase($func)
         .'( '.$self->_recurse_fields($fields->{$func}).' )';
     }
   }
   # Is the second check absolutely necessary?
   elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
-    return $self->_bind_to_sql( $fields );
+    return $self->_fold_sqlbind( $fields );
   }
   else {
     Carp::croak($ref . qq{ unexpected in _recurse_fields()})
@@ -266,19 +338,18 @@ sub _recurse_from {
   return join('', @sqlf);
 }
 
-sub _bind_to_sql {
-  my $self = shift;
-  my $arr  = shift;
-  my $sql = shift @$$arr;
-  $sql =~ s/\?/$self->_quote((shift @$$arr)->[1])/eg;
-  return $sql
+sub _fold_sqlbind {
+  my ($self, $sqlbind) = @_;
+  my $sql = shift @$$sqlbind;
+  push @{$self->{from_bind}}, @$$sqlbind;
+  return $sql;
 }
 
 sub _make_as {
   my ($self, $from) = @_;
-  return join(' ', map { (ref $_ eq 'SCALAR' ? $$_ 
-                        : ref $_ eq 'REF'    ? $self->_bind_to_sql($_) 
-                        : $self->_quote($_)) 
+  return join(' ', map { (ref $_ eq 'SCALAR' ? $$_
+                        : ref $_ eq 'REF'    ? $self->_fold_sqlbind($_)
+                        : $self->_quote($_))
                        } reverse each %{$self->_skip_options($from)});
 }
 
@@ -1321,13 +1392,7 @@ sub insert_bulk {
 #  @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
 
   ## This must be an arrayref, else nothing works!
-  
   my $tuple_status = [];
-  
-  ##use Data::Dumper;
-  ##print STDERR Dumper( $data, $sql, [@bind] );
-
-  my $time = time();
 
   ## Get the bind_attributes, if any exist
   my $bind_attributes = $self->source_bind_attributes($source);