Fix top-level PRIOR with missing '='
Peter Rabbitson [Sun, 11 Apr 2010 12:52:07 +0000 (12:52 +0000)]
Fix weird AND hardcoded in tests
Test quotes as well

lib/DBIx/Class/SQLAHacks/Oracle.pm
t/oracle/connect_by.t

index 60fc90c..5caf0a2 100644 (file)
@@ -1,6 +1,9 @@
 package # Hide from PAUSE
   DBIx::Class::SQLAHacks::Oracle;
 
+use warnings;
+use strict;
+
 use base qw( DBIx::Class::SQLAHacks );
 use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
 
@@ -10,6 +13,17 @@ use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
 #   - Problem with count and connect_by look the TODO in t/73oracle.t
 # 
 
+sub new {
+  my $self = shift;
+  my %opts = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
+  push @{$opts{special_ops}}, {
+    regex => qr/^prior$/i,
+    handler => '_where_field_PRIOR',
+  };
+
+  $self->SUPER::new (\%opts);
+}
+
 sub select {
     my ($self, $table, $fields, $where, $order, @rest) = @_;
 
@@ -86,6 +100,21 @@ sub _order_siblings_by {
     return wantarray ? ( $sql, @bind ) : $sql;
 }
 
+# we need to add a '=' only when PRIOR is used against a column diretly
+# i.e. when it is invoked by a special_op callback
+sub _where_field_PRIOR {
+  my ($self, $lhs, $op, $rhs) = @_;
+  my ($sql, @bind) = $self->_recurse_where ($rhs);
+
+  $sql = sprintf ('%s = %s %s ',
+    $self->_convert($self->_quote($lhs)),
+    $self->_sqlcase ($op),
+    $sql
+  );
+
+  return ($sql, @bind);
+}
+
 1;
 
 __END__
index ca230e0..1d36abf 100644 (file)
@@ -17,15 +17,15 @@ use DBIx::Class::SQLAHacks::Oracle;
 my @handle_tests = (
     {
         connect_by  => { 'parentid' => { '-prior' => \'artistid' } },
-        stmt        => "parentid = PRIOR( artistid )",
+        stmt        => '"parentid" = PRIOR artistid',
         bind        => [],
-        msg         => 'Simple: parentid = PRIOR artistid',
+        msg         => 'Simple: "parentid" = PRIOR artistid',
     },
     {
         connect_by  => { 'parentid' => { '!=' => { '-prior' => \'artistid' } } },
-        stmt        => "parentid != PRIOR( artistid )",
+        stmt        => '"parentid" != ( PRIOR artistid )',
         bind        => [],
-        msg         => 'Simple: parentid != PRIOR artistid',
+        msg         => 'Simple: "parentid" != ( PRIOR artistid )',
     },
     # Examples from http://download.oracle.com/docs/cd/B19306_01/server.102/b14200/queries003.htm
 
@@ -35,18 +35,18 @@ my @handle_tests = (
             last_name => { '!=' => 'King' },
             manager_id => { '-prior' => \'employee_id' },
         ],
-        stmt        => "( last_name != ? AND manager_id = PRIOR( employee_id ) )",
+        stmt        => '( "last_name" != ? OR "manager_id" = PRIOR employee_id )',
         bind        => ['King'],
         msg         => 'oracle.com example #1',
     },
     # CONNECT BY PRIOR employee_id = manager_id and 
     #            PRIOR account_mgr_id = customer_id ...
     {
-        connect_by  => [
+        connect_by  => {
             manager_id => { '-prior' => \'employee_id' },
-            customer_id => { '-prior' => \'account_mgr_id' },
-        ],
-        stmt        => "( manager_id = PRIOR( employee_id ) AND customer_id = PRIOR( account_mgr_id ) )",
+            customer_id => { '>', { '-prior' => \'account_mgr_id' } },
+        },
+        stmt        => '( "customer_id" > ( PRIOR account_mgr_id ) AND "manager_id" = PRIOR employee_id )',
         bind        => [],
         msg         => 'oracle.com example #2',
     },
@@ -54,7 +54,7 @@ my @handle_tests = (
     # TODO: NOCYCLE parameter doesn't work
 );
 
-my $sqla_oracle = DBIx::Class::SQLAHacks::Oracle->new();
+my $sqla_oracle = DBIx::Class::SQLAHacks::Oracle->new( quote_char => '"', name_sep => '.' );
 isa_ok($sqla_oracle, 'DBIx::Class::SQLAHacks::Oracle');
 
 
@@ -68,7 +68,7 @@ for my $case (@handle_tests) {
     );
     lives_ok(
         sub {
-            ( $stmt, @bind ) = $sqla_oracle->_recurse_where( $case->{connect_by}, 'and' );
+            ( $stmt, @bind ) = $sqla_oracle->_recurse_where( $case->{connect_by} );
             is_same_sql_bind( $stmt, \@bind, $case->{stmt}, $case->{bind},$msg )
               || diag "Search term:\n" . Dumper $case->{connect_by};
         }