Use SQL::Abstract 1.61_01, add some tests.
Robert Bohne [Fri, 12 Mar 2010 08:00:54 +0000 (08:00 +0000)]
Makefile.PL
lib/DBIx/Class/SQLAHacks/Oracle.pm
t/oracle/connect_by.t

index 9d087b2..e5607fa 100644 (file)
@@ -45,7 +45,7 @@ my $runtime_requires = {
   'MRO::Compat'              => '0.09',
   'Module::Find'             => '0.06',
   'Path::Class'              => '0.18',
-  'SQL::Abstract'            => '1.61',
+  'SQL::Abstract'            => '1.61_01',
   'SQL::Abstract::Limit'     => '0.13',
   'Sub::Name'                => '0.04',
   'Data::Dumper::Concise'    => '1.000',
index fd0f20e..a4a815e 100644 (file)
@@ -6,28 +6,12 @@ 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 :-)
+#   - Review by experienced DBIC/SQL:A developers :-)
+#   - Check NOCYCLE parameter
+#       http://download.oracle.com/docs/cd/B19306_01/server.102/b14200/pseudocolumns001.htm#i1009434
 # 
 
-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) = @_;
 
@@ -94,85 +78,6 @@ 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__
index b40ebce..9a61920 100644 (file)
@@ -17,36 +17,41 @@ 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',
     },
-    # {
-        # TODO: Can't handle this...
-        # connect_by  => { 'parentid' => { '!=' => { '-prior' => \'artistid' } } },
-        # connect_by  => [ \'parentid',  ],
-        # stmt        => "parentid != PRIOR artistid ",
-        # bind        => [],
-        # msg         => 'Simple: parentid != PRIOR artistid',
-    # },
+    {
+        connect_by  => { 'parentid' => { '!=' => { '-prior' => \'artistid' } } },
+        stmt        => "parentid != PRIOR( artistid )",
+        bind        => [],
+        msg         => 'Simple: parentid != PRIOR artistid',
+    },
+    # Example from http://download.oracle.com/docs/cd/B19306_01/server.102/b14200/queries003.htm
 
-    # Excample from http://download.oracle.com/docs/cd/B19306_01/server.102/b14200/queries003.htm
+    # CONNECT BY last_name != 'King' AND PRIOR employee_id = manager_id ...
     {
-        connect_by => [
-            'last_name' => { '!=' => 'King' },
-            '-prior' => [ \'employee_id', \'manager_id' ],
+        connect_by  => [
+            last_name => { '!=' => 'King' },
+            manager_id => { '-prior' => \'employee_id' },
         ],
-        stmt => "( last_name != ? AND PRIOR employee_id = manager_id )",
-        bind => ['King'],
+        stmt        => "( last_name != ? AND manager_id = PRIOR( employee_id ) )",
+        bind        => ['King'],
+        msg         => 'oracle.com excample #1',
     },
+    # CONNECT BY PRIOR employee_id = manager_id and 
+    #            PRIOR account_mgr_id = customer_id ...
     {
-        connect_by => [
-            '-prior' => [ \'employee_id', \'manager_id' ],
-            '-prior' => [ \'account_mgr_id', \'customer_id' ],
+        connect_by  => [
+            manager_id => { '-prior' => \'employee_id' },
+            customer_id => { '-prior' => \'account_mgr_id' },
         ],
-        stmt => "( PRIOR employee_id = manager_id AND PRIOR account_mgr_id = customer_id )",
-        bind => [],
+        stmt        => "( manager_id = PRIOR( employee_id ) AND customer_id = PRIOR( account_mgr_id ) )",
+        bind        => [],
+        msg         => 'oracle.com excample #2',
     },
+    # CONNECT BY NOCYCLE PRIOR employee_id = manager_id AND LEVEL <= 4;
+    # TODO: NOCYCLE parameter doesn't work
 );
 
 my $sqla_oracle = DBIx::Class::SQLAHacks::Oracle->new();