From: Peter Rabbitson Date: Sun, 11 Apr 2010 12:52:07 +0000 (+0000) Subject: Fix top-level PRIOR with missing '=' X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9ab1e5f01d9c869a08f87301e18a518d5f11edc5;p=dbsrgits%2FDBIx-Class-Historic.git Fix top-level PRIOR with missing '=' Fix weird AND hardcoded in tests Test quotes as well --- diff --git a/lib/DBIx/Class/SQLAHacks/Oracle.pm b/lib/DBIx/Class/SQLAHacks/Oracle.pm index 60fc90c..5caf0a2 100644 --- a/lib/DBIx/Class/SQLAHacks/Oracle.pm +++ b/lib/DBIx/Class/SQLAHacks/Oracle.pm @@ -1,6 +1,9 @@ package # Hide from PAUSE DBIx::Class::SQLAHacks::Oracle; +use warnings; +use strict; + use base qw( DBIx::Class::SQLAHacks ); use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/; @@ -10,6 +13,17 @@ use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/; # - Problem with count and connect_by look the TODO in t/73oracle.t # +sub new { + my $self = shift; + my %opts = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_; + push @{$opts{special_ops}}, { + regex => qr/^prior$/i, + handler => '_where_field_PRIOR', + }; + + $self->SUPER::new (\%opts); +} + sub select { my ($self, $table, $fields, $where, $order, @rest) = @_; @@ -86,6 +100,21 @@ sub _order_siblings_by { return wantarray ? ( $sql, @bind ) : $sql; } +# we need to add a '=' only when PRIOR is used against a column diretly +# i.e. when it is invoked by a special_op callback +sub _where_field_PRIOR { + my ($self, $lhs, $op, $rhs) = @_; + my ($sql, @bind) = $self->_recurse_where ($rhs); + + $sql = sprintf ('%s = %s %s ', + $self->_convert($self->_quote($lhs)), + $self->_sqlcase ($op), + $sql + ); + + return ($sql, @bind); +} + 1; __END__ diff --git a/t/oracle/connect_by.t b/t/oracle/connect_by.t index ca230e0..1d36abf 100644 --- a/t/oracle/connect_by.t +++ b/t/oracle/connect_by.t @@ -17,15 +17,15 @@ 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', + msg => 'Simple: "parentid" = PRIOR artistid', }, { connect_by => { 'parentid' => { '!=' => { '-prior' => \'artistid' } } }, - stmt => "parentid != PRIOR( artistid )", + stmt => '"parentid" != ( PRIOR artistid )', bind => [], - msg => 'Simple: parentid != PRIOR artistid', + msg => 'Simple: "parentid" != ( PRIOR artistid )', }, # Examples from http://download.oracle.com/docs/cd/B19306_01/server.102/b14200/queries003.htm @@ -35,18 +35,18 @@ my @handle_tests = ( last_name => { '!=' => 'King' }, manager_id => { '-prior' => \'employee_id' }, ], - stmt => "( last_name != ? AND manager_id = PRIOR( employee_id ) )", + stmt => '( "last_name" != ? OR "manager_id" = PRIOR employee_id )', bind => ['King'], msg => 'oracle.com example #1', }, # CONNECT BY PRIOR employee_id = manager_id and # PRIOR account_mgr_id = customer_id ... { - connect_by => [ + connect_by => { manager_id => { '-prior' => \'employee_id' }, - customer_id => { '-prior' => \'account_mgr_id' }, - ], - stmt => "( manager_id = PRIOR( employee_id ) AND customer_id = PRIOR( account_mgr_id ) )", + customer_id => { '>', { '-prior' => \'account_mgr_id' } }, + }, + stmt => '( "customer_id" > ( PRIOR account_mgr_id ) AND "manager_id" = PRIOR employee_id )', bind => [], msg => 'oracle.com example #2', }, @@ -54,7 +54,7 @@ my @handle_tests = ( # TODO: NOCYCLE parameter doesn't work ); -my $sqla_oracle = DBIx::Class::SQLAHacks::Oracle->new(); +my $sqla_oracle = DBIx::Class::SQLAHacks::Oracle->new( quote_char => '"', name_sep => '.' ); isa_ok($sqla_oracle, 'DBIx::Class::SQLAHacks::Oracle'); @@ -68,7 +68,7 @@ for my $case (@handle_tests) { ); lives_ok( sub { - ( $stmt, @bind ) = $sqla_oracle->_recurse_where( $case->{connect_by}, 'and' ); + ( $stmt, @bind ) = $sqla_oracle->_recurse_where( $case->{connect_by} ); is_same_sql_bind( $stmt, \@bind, $case->{stmt}, $case->{bind},$msg ) || diag "Search term:\n" . Dumper $case->{connect_by}; }