[Bast-commits] r8140 - in
DBIx-Class/0.08/branches/oracle_hierarchical_queries_rt39121:
lib/DBIx/Class/SQLAHacks t t/oracle
rbo at dev.catalyst.perl.org
rbo at dev.catalyst.perl.org
Fri Dec 18 11:51:16 GMT 2009
Author: rbo
Date: 2009-12-18 11:51:16 +0000 (Fri, 18 Dec 2009)
New Revision: 8140
Added:
DBIx-Class/0.08/branches/oracle_hierarchical_queries_rt39121/t/oracle/
DBIx-Class/0.08/branches/oracle_hierarchical_queries_rt39121/t/oracle/connect_by.t
Modified:
DBIx-Class/0.08/branches/oracle_hierarchical_queries_rt39121/lib/DBIx/Class/SQLAHacks/Oracle.pm
DBIx-Class/0.08/branches/oracle_hierarchical_queries_rt39121/t/73oracle.t
Log:
Add PRIOR as special and unary op to SQLAHacks::Oracle and use _recurse_where to create the connect_by sql statment
Modified: DBIx-Class/0.08/branches/oracle_hierarchical_queries_rt39121/lib/DBIx/Class/SQLAHacks/Oracle.pm
===================================================================
--- DBIx-Class/0.08/branches/oracle_hierarchical_queries_rt39121/lib/DBIx/Class/SQLAHacks/Oracle.pm 2009-12-17 22:23:33 UTC (rev 8139)
+++ DBIx-Class/0.08/branches/oracle_hierarchical_queries_rt39121/lib/DBIx/Class/SQLAHacks/Oracle.pm 2009-12-18 11:51:16 UTC (rev 8140)
@@ -4,6 +4,30 @@
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 @@
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 @@
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, at all_bind);
+ },
+ FALLBACK => sub {
+
+ # TODO
+ $self->puke(" wrong way... :/ ");
+ },
+ }
+ );
+ return ( $sql, @bind );
+};
+
1;
__END__
Modified: DBIx-Class/0.08/branches/oracle_hierarchical_queries_rt39121/t/73oracle.t
===================================================================
--- DBIx-Class/0.08/branches/oracle_hierarchical_queries_rt39121/t/73oracle.t 2009-12-17 22:23:33 UTC (rev 8139)
+++ DBIx-Class/0.08/branches/oracle_hierarchical_queries_rt39121/t/73oracle.t 2009-12-18 11:51:16 UTC (rev 8140)
@@ -328,7 +328,7 @@
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 @@
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 @@
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 @@
{
'join' => 'cds',
'start_with' => { 'name' => 'root' },
- 'connect_by' => { 'parentid' => 'prior artistid'},
+ 'connect_by' => { 'parentid' => { '-prior' => \'artistid' } },
});
=pod
SELECT
@@ -479,7 +479,7 @@
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 @@
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,
Added: DBIx-Class/0.08/branches/oracle_hierarchical_queries_rt39121/t/oracle/connect_by.t
===================================================================
--- DBIx-Class/0.08/branches/oracle_hierarchical_queries_rt39121/t/oracle/connect_by.t (rev 0)
+++ DBIx-Class/0.08/branches/oracle_hierarchical_queries_rt39121/t/oracle/connect_by.t 2009-12-18 11:51:16 UTC (rev 8140)
@@ -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 );
More information about the Bast-commits
mailing list