From: Robert Bohne Date: Fri, 18 Dec 2009 11:51:16 +0000 (+0000) Subject: Add PRIOR as special and unary op to SQLAHacks::Oracle and use _recurse_where to... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=43426175a56c02bf2ab64a902df2b317ca585fa3;p=dbsrgits%2FDBIx-Class-Historic.git Add PRIOR as special and unary op to SQLAHacks::Oracle and use _recurse_where to create the connect_by sql statment --- diff --git a/lib/DBIx/Class/SQLAHacks/Oracle.pm b/lib/DBIx/Class/SQLAHacks/Oracle.pm index 3af05ce..fd0f20e 100644 --- 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 --- 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 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 );