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

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / SQLAHacks / Oracle.pm

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__