Add PRIOR as special and unary op to SQLAHacks::Oracle and use _recurse_where to...

diff --git a/lib/DBIx/Class/SQLAHacks/Oracle.pm b/lib/DBIx/Class/SQLAHacks/Oracle.pm
index 3af05ce..fd0f20e 100644 (file)
--- a/lib/DBIx/Class/SQLAHacks/Oracle.pm
+++ b/lib/DBIx/Class/SQLAHacks/Oracle.pm
@@ -4,6 +4,30 @@ package # Hide from PAUSE
 use base qw( DBIx::Class::SQLAHacks );
 use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
 
+# 
+#  TODO:
+#   - Problems with such statements: parentid != PRIOR artistid
+#   - Check the parameter syntax of connect_by
+#   - Review review by experienced DBIC/SQL:A developers :-)
+# 
+
+sub new {
+  my $self = shift->SUPER::new(@_);
+
+  push @{ $self->{unary_ops} },{
+      regex   => qr/^prior$/,
+      handler => '_prior_as_unary_op',
+  };
+
+  push @{ $self->{special_ops} },{
+      regex   => qr/^prior$/,
+      handler => '_prior_as_special_op',
+  };
+
+  return $self;
+}
+
+
 sub select {
     my ($self, $table, $fields, $where, $order, @rest) = @_;
 
@@ -38,10 +62,16 @@ sub _connect_by {
             push @bind, @wb;
         }
         if ( my $connect_by = $attrs->{'connect_by'}) {
-            $sql .= $self->_sqlcase(' connect by');
-            foreach my $key ( keys %$connect_by ) {
-                $sql .= " $key = " . $connect_by->{$key};
-            }
+            my ($connect_by_sql, @connect_by_sql_bind) = $self->_recurse_where( $attrs->{'connect_by'} );
+            $sql .= sprintf(" %s %s",
+                $self->_sqlcase('connect by'),
+                $connect_by_sql,
+            );
+            push @bind, @connect_by_sql_bind;
+            # $sql .= $self->_sqlcase(' connect by');
+            #             foreach my $key ( keys %$connect_by ) {
+            #                 $sql .= " $key = " . $connect_by->{$key};
+            #             }
         }
         if ( $attrs->{'order_siblings_by'} ) {
             $sql .= $self->_order_siblings_by( $attrs->{'order_siblings_by'} );
@@ -64,6 +94,85 @@ sub _order_siblings_by {
     return $val ? $self->_sqlcase(' order siblings by')." $val" : '';
 }
 
+sub _prior_as_special_op {
+    my ( $self, $field, $op, $arg ) = @_;
+
+    my ( $label, $and, $placeholder );
+    $label       = $self->_convert( $self->_quote($field) );
+    $and         = ' ' . $self->_sqlcase('and') . ' ';
+    $placeholder = $self->_convert('?');
+
+    # TODO: $op is prior, and not the operator
+    $op          = $self->_sqlcase('=');
+
+    my ( $sql, @bind ) = $self->_SWITCH_refkind(
+        $arg,
+        {
+            SCALARREF => sub {
+                my $sql = sprintf( "%s %s PRIOR %s", $label, $op, $$arg );
+                return $sql;
+            },
+            SCALAR => sub {
+                my $sql = sprintf( "%s %s PRIOR %s", $label, $op, $placeholder );
+                return ( $sql, $arg );
+            },
+            HASHREF => sub {    # case { '-prior' => { '=<' => 'nwiger'} }
+                                # no _convert and _quote from SCALARREF
+                my ( $sql, @bind ) = $self->_where_hashpair_HASHREF( $field, $arg, $op );
+                $sql = sprintf( " PRIOR %s", $sql );
+                return ( $sql, @bind );
+            },
+            FALLBACK => sub {
+                # TODO
+                $self->puke(" wrong way... :/");
+            },
+        }
+    );
+    return ( $sql, @bind );
+}
+
+sub _prior_as_unary_op {
+    my ( $self, $op, $arg ) = @_;
+
+    my $placeholder = $self->_convert('?');
+    my $and         = ' ' . $self->_sqlcase('and') . ' ';
+
+    my ( $sql, @bind ) = $self->_SWITCH_refkind(
+        $arg,
+        {
+            ARRAYREF => sub {
+                $self->puke("special op 'prior' accepts an arrayref with exactly two values")
+                  if @$arg != 2;
+
+                my ( @all_sql, @all_bind );
+
+                foreach my $val ( @{$arg} ) {
+                    my ( $sql, @bind ) = $self->_SWITCH_refkind($val,
+                        {
+                            SCALAR => sub {
+                                return ( $placeholder, ($val) );
+                            },
+                            SCALARREF => sub {
+                                return ( $$val, () );
+                            },
+                        }
+                    );
+                    push @all_sql, $sql;
+                    push @all_bind, @bind;
+                }
+                my $sql = sprintf("PRIOR %s ",join $self->_sqlcase('='), @all_sql);
+                return ($sql,@all_bind);
+            },
+            FALLBACK => sub {
+
+                # TODO
+                $self->puke(" wrong way... :/ ");
+            },
+        }
+    );
+    return ( $sql, @bind );
+};
+
 1;
 
 __END__

diff --git a/t/73oracle.t b/t/73oracle.t
index 90698ea..c1ef40b 100644 (file)
--- a/t/73oracle.t
+++ b/t/73oracle.t
@@ -328,7 +328,7 @@ if ( $schema->storage->isa('DBIx::Class::Storage::DBI::Oracle::Generic') ) {
       my $rs = $schema->resultset('Artist')->search({},
                               {
                                 'start_with' => { 'name' => 'root' },
-                                'connect_by' => { 'parentid' => 'prior artistid'},
+                                'connect_by' => { 'parentid' => { '-prior' => \'artistid' } },
                               });
 =pod
     SELECT
@@ -367,7 +367,7 @@ if ( $schema->storage->isa('DBIx::Class::Storage::DBI::Oracle::Generic') ) {
       my $rs = $schema->resultset('Artist')->search({},
                               {
                                 'start_with' => { 'name' => 'root' },
-                                'connect_by' => { 'parentid' => 'prior artistid'},
+                                'connect_by' => { 'parentid' => { '-prior' => \'artistid' } },
                                 'order_siblings_by' => 'name DESC',
                               });
       my $ok = 1;
@@ -396,7 +396,7 @@ if ( $schema->storage->isa('DBIx::Class::Storage::DBI::Oracle::Generic') ) {
       my $rs = $schema->resultset('Artist')->search({ parentid => undef },
                               {
                                 'start_with' => { 'name' => 'greatgrandchild' },
-                                'connect_by' => { 'prior parentid' => 'artistid'},
+                                'connect_by' => { '-prior' => [  \'parentid', \'artistid' ] } ,
                               });
 =pod
     SELECT
@@ -436,7 +436,7 @@ if ( $schema->storage->isa('DBIx::Class::Storage::DBI::Oracle::Generic') ) {
                               {
                                 'join' => 'cds',
                                 'start_with' => { 'name' => 'root' },
-                                'connect_by' => { 'parentid' => 'prior artistid'},
+                                'connect_by' => { 'parentid' => { '-prior' => \'artistid' } },
                               });
 =pod
     SELECT
@@ -479,7 +479,7 @@ if ( $schema->storage->isa('DBIx::Class::Storage::DBI::Oracle::Generic') ) {
       my $rs = $schema->resultset('Artist')->search({},
                               {
                                 'start_with' => { 'name' => 'greatgrandchild' },
-                                'connect_by' => { 'prior parentid' => 'artistid'},
+                                'connect_by' => { '-prior' => [ \'parentid', \'artistid' ] },
                                 'order_by' => 'name ASC',
                               });
       my $ok = 1;
@@ -508,7 +508,7 @@ if ( $schema->storage->isa('DBIx::Class::Storage::DBI::Oracle::Generic') ) {
       my $rs = $schema->resultset('Artist')->search({},
                               {
                                 'start_with' => { 'name' => 'greatgrandchild' },
-                                'connect_by' => { 'prior parentid' => 'artistid'},
+                                'connect_by' => { '-prior' => [ \'parentid', \'artistid' ] },
                                 'order_by' => 'name ASC',
                                 'rows' => 2,
                                 'page' => 1,

diff --git a/t/oracle/connect_by.t b/t/oracle/connect_by.t
new file mode 100644 (file)
index 0000000..b40ebce
--- /dev/null
+++ b/t/oracle/connect_by.t
@@ -0,0 +1,78 @@
+
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+use Data::Dumper;
+use lib qw(t/lib);
+use DBIC::SqlMakerTest;
+use DBIx::Class::SQLAHacks::Oracle;
+
+
+
+# 
+#  Offline test for connect_by 
+#  ( without acitve database connection)
+# 
+my @handle_tests = (
+    {
+        connect_by  => { 'parentid' => { '-prior' => \'artistid' } },
+        stmt        => " parentid = PRIOR artistid ",
+        bind        => [],
+        msg         => 'Simple: parentid = PRIOR artistid',
+    },
+    # {
+        # TODO: Can't handle this...
+        # connect_by  => { 'parentid' => { '!=' => { '-prior' => \'artistid' } } },
+        # connect_by  => [ \'parentid',  ],
+        # stmt        => "parentid != PRIOR artistid ",
+        # bind        => [],
+        # msg         => 'Simple: parentid != PRIOR artistid',
+    # },
+
+    # Excample from http://download.oracle.com/docs/cd/B19306_01/server.102/b14200/queries003.htm
+    {
+        connect_by => [
+            'last_name' => { '!=' => 'King' },
+            '-prior' => [ \'employee_id', \'manager_id' ],
+        ],
+        stmt => "( last_name != ? AND PRIOR employee_id = manager_id )",
+        bind => ['King'],
+    },
+    {
+        connect_by => [
+            '-prior' => [ \'employee_id', \'manager_id' ],
+            '-prior' => [ \'account_mgr_id', \'customer_id' ],
+        ],
+        stmt => "( PRIOR employee_id = manager_id AND PRIOR account_mgr_id = customer_id )",
+        bind => [],
+    },
+);
+
+my $sqla_oracle = DBIx::Class::SQLAHacks::Oracle->new();
+isa_ok($sqla_oracle, 'DBIx::Class::SQLAHacks::Oracle');
+
+
+my $test_count = ( @handle_tests * 2 ) + 1;
+
+for my $case (@handle_tests) {
+    local $Data::Dumper::Terse = 1;
+    my ( $stmt, @bind );
+    my $msg = sprintf("Offline: %s",
+        $case->{msg} || substr($case->{stmt},0,25),
+    );
+    lives_ok(
+        sub {
+            ( $stmt, @bind ) = $sqla_oracle->_recurse_where( $case->{connect_by}, 'and' );
+            is_same_sql_bind( $stmt, \@bind, $case->{stmt}, $case->{bind},$msg )
+              || diag "Search term:\n" . Dumper $case->{connect_by};
+        }
+    ,sprintf("lives is ok from '%s'",$msg));
+}
+
+# 
+#   Online Tests?
+# 
+$test_count += 0;
+
+done_testing( $test_count );