[Bast-commits] r6453 - in SQL-Abstract/1.x/trunk: lib/SQL t

[ribasushi at dev.catalyst.perl.org]

Author: ribasushi
Date: 2009-05-29 15:41:10 +0000 (Fri, 29 May 2009)
New Revision: 6453

Modified:
   SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm
   SQL-Abstract/1.x/trunk/t/06order_by.t
Log:
Fix for _order_by with bind values - will not work on DBIC - needs matching changes to SQLAHacks

Modified: SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm
===================================================================
--- SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm	2009-05-29 13:41:22 UTC (rev 6452)
+++ SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm	2009-05-29 15:41:10 UTC (rev 6453)
@@ -813,50 +813,79 @@
 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];
+    },
+  });
 }
 
 
-
 #======================================================================
 # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
 #======================================================================

Modified: SQL-Abstract/1.x/trunk/t/06order_by.t
===================================================================
--- SQL-Abstract/1.x/trunk/t/06order_by.t	2009-05-29 13:41:22 UTC (rev 6452)
+++ SQL-Abstract/1.x/trunk/t/06order_by.t	2009-05-29 15:41:10 UTC (rev 6453)
@@ -90,7 +90,14 @@
     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 @@
 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 (