From: Peter Rabbitson <ribasushi@cpan.org>
Date: Fri, 29 May 2009 15:41:10 +0000 (+0000)
Subject: Fix for _order_by with bind values - will not work on DBIC - needs matching changes... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f267b646207361aa110bff7df661b5881b5c8319;p=scpubgit%2FQ-Branch.git

Fix for _order_by with bind values - will not work on DBIC - needs matching changes to SQLAHacks
---

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 05c2271..ad17722 100644
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -813,48 +813,77 @@ sub _where_field_IN {
 sub _order_by {
   my ($self, $arg) = @_;
 
-  # construct list of ordering instructions
-  my @order = $self->_SWITCH_refkind($arg, {
+  my (@sql, @bind);
+  for my $c ($self->_order_by_chunks ($arg) ) {
+    $self->_SWITCH_refkind ($c, {
+      SCALAR => sub { push @sql, $c },
+      ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
+    });
+  }
+
+  my $sql = @sql
+    ? sprintf ('%s %s',
+        $self->_sqlcase(' order by'),
+        join (', ', @sql)
+      )
+    : ''
+  ;
+
+  return wantarray ? ($sql, @bind) : $sql;
+}
+
+sub _order_by_chunks {
+  my ($self, $arg) = @_;
+
+  return $self->_SWITCH_refkind($arg, {
 
     ARRAYREF => sub {
-      map {$self->_SWITCH_refkind($_, {
-              SCALAR    => sub {$self->_quote($_)},
-              UNDEF     => sub {},
-              SCALARREF => sub {$$_}, # literal SQL, no quoting
-              HASHREF   => sub {$self->_order_by_hash($_)}
-             }) } @$arg;
+      map { $self->_order_by_chunks ($_ ) } @$arg;
     },
 
+    ARRAYREFREF => sub { [ @$$arg ] },
+
     SCALAR    => sub {$self->_quote($arg)},
-    UNDEF     => sub {},
+
+    UNDEF     => sub {return () },
+
     SCALARREF => sub {$$arg}, # literal SQL, no quoting
-    HASHREF   => sub {$self->_order_by_hash($arg)},
 
-  });
+    HASHREF   => sub {
+      # get first pair in hash
+      my ($key, $val) = each %$arg;
 
-  # build SQL
-  my $order = join ', ', @order;
-  return $order ? $self->_sqlcase(' order by')." $order" : '';
-}
+      return () unless $key;
 
+      if ( (keys %$arg) > 1 or not $key =~ /^-(desc|asc)/i ) {
+        puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
+      }
 
-sub _order_by_hash {
-  my ($self, $hash) = @_;
+      my $direction = $1;
 
-  # get first pair in hash
-  my ($key, $val) = each %$hash;
+      my (@sql, @bind);
+      for my $c ($self->_order_by_chunks ($val)) {
 
-  # check if one pair was found and no other pair in hash
-  $key && !(each %$hash)
-    or puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
 
-  my ($order) = ($key =~ /^-(desc|asc)/i)
-    or puke "invalid key in _order_by hash : $key";
 
-  $val = ref $val eq 'ARRAY' ? $val : [$val];
-  return join ', ', map { $self->_quote($_) . ' ' . $self->_sqlcase($order) } @$val;
-}
+        $self->_SWITCH_refkind ($c, {
+          SCALAR => sub {
+            push @sql, $c
+          },
+          ARRAYREF => sub {
+            my ($s, @b) = @$c;
+            push @sql, $s;
+            push @bind, @b;
+          },
+        });
+      }
+
+      my $sql = join ', ', map { $_ . ' ' . $self->_sqlcase($direction) } @sql;
 
+      return [$sql, @bind];
+    },
+  });
+}
 
 
 #======================================================================
diff --git a/t/06order_by.t b/t/06order_by.t
index 7d2ccf4..9822d61 100644
--- a/t/06order_by.t
+++ b/t/06order_by.t
@@ -90,6 +90,13 @@ my @cases =
     given => { -desc => \['colA LIKE ?', 'test'] },
     expects => ' ORDER BY colA LIKE ? DESC',
     expects_quoted => ' ORDER BY colA LIKE ? DESC',
+    bind => ['test'],
+   },
+   {
+    given => [ { -asc => \['colA'] }, { -desc => \['colB LIKE ?', 'test'] }, { -asc => \['colC LIKE ?', 'tost'] }],
+    expects => ' ORDER BY colA ASC, colB LIKE ? DESC, colC LIKE ? ASC',
+    expects_quoted => ' ORDER BY colA ASC, colB LIKE ? DESC, colC LIKE ? ASC',
+    bind => [qw/test tost/],
    },
   );
 
@@ -99,9 +106,24 @@ plan tests => (scalar(@cases) * 2) + 2;
 my $sql  = SQL::Abstract->new;
 my $sqlq = SQL::Abstract->new({quote_char => '`'});
 
-for my $case( @cases){
-  is($sql->_order_by($case->{given}), $case->{expects});
-  is($sqlq->_order_by($case->{given}), $case->{expects_quoted});
+for my $case( @cases) {
+  my ($stat, @bind);
+
+  ($stat, @bind) = $sql->_order_by($case->{given});
+  is_same_sql_bind (
+    $stat,
+    \@bind,
+    $case->{expects},
+    $case->{bind} || [],
+  );
+
+  ($stat, @bind) = $sqlq->_order_by($case->{given});
+  is_same_sql_bind (
+    $stat,
+    \@bind,
+    $case->{expects_quoted},
+    $case->{bind} || [],
+  );
 }
 
 throws_ok (