package # Hide from PAUSE
DBIx::Class::SQLMaker::OracleJoins;
+use warnings;
+use strict;
+
use base qw( DBIx::Class::SQLMaker::Oracle );
sub select {
my ($self, $table, $fields, $where, $rs_attrs, @rest) = @_;
+ # pull out all join conds as regular WHEREs from all extra tables
if (ref($table) eq 'ARRAY') {
- $where = $self->_oracle_joins($where, @{ $table });
+ $where = $self->_oracle_joins($where, @{ $table }[ 1 .. $#$table ]);
}
- return $self->SUPER::select($table, $fields, $where, $rs_attrs, @rest);
+ return $self->next::method($table, $fields, $where, $rs_attrs, @rest);
}
sub _recurse_from {
}
sub _oracle_joins {
- my ($self, $where, $from, @join) = @_;
- my $join_where = {};
- $self->_recurse_oracle_joins($join_where, $from, @join);
+ my ($self, $where, @join) = @_;
+ my $join_where = $self->_recurse_oracle_joins(@join);
+
if (keys %$join_where) {
if (!defined($where)) {
$where = $join_where;
}
sub _recurse_oracle_joins {
- my ($self, $where, $from, @join) = @_;
+ my $self = shift;
- foreach my $j (@join) {
+ my @where;
+ for my $j (@_) {
my ($to, $on) = @{ $j };
- if (ref $to eq 'ARRAY') {
- $self->_recurse_oracle_joins($where, @{ $to });
- }
+ push @where, $self->_recurse_oracle_joins(@{ $to })
+ if (ref $to eq 'ARRAY');
- my $to_jt = ref $to eq 'ARRAY' ? $to->[0] : $to;
+ my $join_opts = ref $to eq 'ARRAY' ? $to->[0] : $to;
my $left_join = q{};
my $right_join = q{};
- if (ref $to_jt eq 'HASH' and exists $to_jt->{-join_type}) {
+ if (ref $join_opts eq 'HASH' and my $jt = $join_opts->{-join_type}) {
#TODO: Support full outer joins -- this would happen much earlier in
#the sequence since oracle 8's full outer join syntax is best
#described as INSANE.
$self->throw_exception("Can't handle full outer joins in Oracle 8 yet!\n")
- if $to_jt->{-join_type} =~ /full/i;
+ if $jt =~ /full/i;
- $left_join = q{(+)} if $to_jt->{-join_type} =~ /left/i
- && $to_jt->{-join_type} !~ /inner/i;
+ $left_join = q{(+)} if $jt =~ /left/i
+ && $jt !~ /inner/i;
- $right_join = q{(+)} if $to_jt->{-join_type} =~ /right/i
- && $to_jt->{-join_type} !~ /inner/i;
+ $right_join = q{(+)} if $jt =~ /right/i
+ && $jt !~ /inner/i;
}
- foreach my $lhs (keys %{ $on }) {
- $where->{$lhs . $left_join} = \"= $on->{ $lhs }$right_join";
- }
+ push @where, map { \sprintf ('%s%s = %s%s',
+ $self->_quote($_),
+ $left_join,
+ $self->_quote($on->{$_}),
+ $right_join,
+ )} keys %$on;
}
+
+ return { -and => \@where };
}
1;
=over
-=item select ($\@$;$$@)
-
-Replaces DBIx::Class::SQLMaker's select() method, which calls _oracle_joins()
-to modify the column and table list before calling SUPER::select().
-
-=item _recurse_from ($$\@)
-
-Recursive subroutine that builds the table list.
-
-=item _oracle_joins ($$$@)
+=item select
-Creates the left/right relationship in the where query.
+Overrides DBIx::Class::SQLMaker's select() method, which calls _oracle_joins()
+to modify the column and table list before calling next::method().
=back
=head1 BUGS
-Does not support full outer joins.
-Probably lots more.
+Does not support full outer joins (however neither really does DBIC itself)
=head1 SEE ALSO
DBICTest::Schema::Track->load_components('PK::Auto::Oracle');
-##########
-# recyclebin sometimes comes in the way
-my $on_connect_sql = ["ALTER SESSION SET recyclebin = OFF"];
-
-# iterate all tests on following options
-my @tryopt = (
- { on_connect_do => $on_connect_sql },
- { quote_char => '"', on_connect_do => $on_connect_sql, },
-);
-
-# keep a database handle open for cleanup
-my ($dbh, $dbh2);
-
-# test insert returning
-
# check if we indeed do support stuff
-my $test_server_supports_insert_returning = do {
- my $v = DBICTest::Schema->connect($dsn, $user, $pass)
- ->storage
- ->_get_dbh
- ->get_info(18);
+my $v = do {
+ my $v = DBICTest::Schema->connect($dsn, $user, $pass)->storage->_dbh_get_info(18);
$v =~ /^(\d+)\.(\d+)/
or die "Unparseable Oracle server version: $v\n";
+ sprintf('%d.%03d', $1, $2);
+};
+
+my $test_server_supports_only_orajoins = $v < 8.001;
+
# TODO find out which version supports the RETURNING syntax
# 8i has it and earlier docs are a 404 on oracle.com
- ( $1 > 8 || ($1 == 8 && $2 >= 1) ) ? 1 : 0;
-};
+my $test_server_supports_insert_returning = $v >= 8.001;
+
is (
DBICTest::Schema->connect($dsn, $user, $pass)->storage->_use_insert_returning,
$test_server_supports_insert_returning,
'insert returning capability guessed correctly'
);
+##########
+# recyclebin sometimes comes in the way
+my $on_connect_sql = ["ALTER SESSION SET recyclebin = OFF"];
+
+# iterate all tests on following options
+my @tryopt = (
+ { on_connect_do => $on_connect_sql },
+ { quote_char => '"', on_connect_do => $on_connect_sql },
+);
+
+# keep a database handle open for cleanup
+my ($dbh, $dbh2);
+
my $schema;
-for my $use_insert_returning ($test_server_supports_insert_returning
- ? (1,0)
- : (0)
-) {
-
- no warnings qw/once/;
- local *DBICTest::Schema::connection = subname 'DBICTest::Schema::connection' => sub {
- my $s = shift->next::method (@_);
- $s->storage->_use_insert_returning ($use_insert_returning);
- $s;
- };
-
- for my $opt (@tryopt) {
- # clean all cached sequences from previous run
- for (map { values %{DBICTest::Schema->source($_)->columns_info} } (qw/Artist CD Track/) ) {
- delete $_->{sequence};
- }
+for my $use_insert_returning ($test_server_supports_insert_returning ? (1,0) : (0) ) {
+ for my $force_ora_joins ($test_server_supports_only_orajoins ? (0) : (0,1) ) {
+
+ no warnings qw/once/;
+ local *DBICTest::Schema::connection = subname 'DBICTest::Schema::connection' => sub {
+ my $s = shift->next::method (@_);
+ $s->storage->_use_insert_returning ($use_insert_returning);
+ $s->storage->sql_maker_class('DBIx::Class::SQLMaker::OracleJoins') if $force_ora_joins;
+ $s;
+ };
+
+ for my $opt (@tryopt) {
+ # clean all cached sequences from previous run
+ for (map { values %{DBICTest::Schema->source($_)->columns_info} } (qw/Artist CD Track/) ) {
+ delete $_->{sequence};
+ }
- my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opt);
+ my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opt);
- $dbh = $schema->storage->dbh;
- my $q = $schema->storage->sql_maker->quote_char || '';
+ $dbh = $schema->storage->dbh;
+ my $q = $schema->storage->sql_maker->quote_char || '';
- do_creates($dbh, $q);
+ do_creates($dbh, $q);
- _run_tests($schema, $opt);
+ _run_tests($schema, $opt);
+ }
}
}
is( $it->next->name, "Artist 6", "iterator->next ok" );
is( $it->next, undef, "next past end of resultset ok" );
-
# test identifiers over the 30 char limit
lives_ok {
my @results = $schema->resultset('CD')->search(undef, {
'Partially failed populate did not alter table contents'
);
+# test complex join (exercise orajoins)
+ lives_ok {
+ my @hri = $schema->resultset('CD')->search(
+ { 'artist.name' => 'pop_art_1', 'me.cdid' => { '!=', 999} },
+ { join => 'artist', prefetch => 'tracks', rows => 4, order_by => 'tracks.trackid' }
+ )->hri_dump->all;
+
+ my $expect = [{
+ artist => 1,
+ cdid => 1,
+ genreid => undef,
+ single_track => undef,
+ title => "EP C",
+ tracks => [
+ {
+ cd => 1,
+ last_updated_at => undef,
+ last_updated_on => undef,
+ position => 1,
+ title => "Track1",
+ trackid => 1
+ },
+ {
+ cd => 1,
+ last_updated_at => undef,
+ last_updated_on => undef,
+ position => 1,
+ title => "Track2",
+ trackid => 2
+ },
+ ],
+ year => 2003
+ }];
+
+ is_deeply (
+ \@hri,
+ $expect,
+ 'Correct set of data prefetched',
+ );
+
+ } 'complex prefetch ok';
+
# test sequence detection from a different schema
SKIP: {
TODO: {
projects / dbsrgits/DBIx-Class.git / commitdiff