+use strict;
+use warnings;
+
+use Test::Exception;
+use Test::More;
+use Sub::Name;
+
+use lib qw(t/lib);
+use DBICTest;
+use DBIC::SqlMakerTest;
+
+plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_oracle')
+ unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_oracle');
+
+$ENV{NLS_SORT} = "BINARY";
+$ENV{NLS_COMP} = "BINARY";
+$ENV{NLS_LANG} = "AMERICAN";
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_ORA_${_}" } qw/DSN USER PASS/};
+
+# optional:
+my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_ORA_EXTRAUSER_${_}" } qw/DSN USER PASS/};
+
+plan skip_all => 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test.'
+ unless ($dsn && $user && $pass);
+
{
package # hide from PAUSE
DBICTest::Schema::ArtistFQN;
1;
}
-use strict;
-use warnings;
-
-use Test::Exception;
-use Test::More;
-use Sub::Name;
-
-use lib qw(t/lib);
-use DBICTest;
-use DBIC::SqlMakerTest;
-
-plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_oracle')
- unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_oracle');
-
-$ENV{NLS_SORT} = "BINARY";
-$ENV{NLS_COMP} = "BINARY";
-$ENV{NLS_LANG} = "AMERICAN";
-
-my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_ORA_${_}" } qw/DSN USER PASS/};
-
-# optional:
-my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_ORA_EXTRAUSER_${_}" } qw/DSN USER PASS/};
-
-plan skip_all => 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test.'
- unless ($dsn && $user && $pass);
-
DBICTest::Schema->load_classes('ArtistFQN');
# This is in Core now, but it's here just to test that it doesn't break
DBICTest::Schema::Track->load_components('PK::Auto::Oracle');
+# check if we indeed do support stuff
+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);
+};
+
+# while 8i (8.1) does not document support for ansi joins, and the the drivers do not use
+# them because performance sucks, there is strong evidence they are in fact supported
+# means we can test 'em :)
+my $test_server_supports_only_orajoins = $v < 8.001;
+
+# TODO find out which version supports the RETURNING syntax
+# 8i (8.1) has it and earlier docs are a 404 on oracle.com
+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, },
+ { 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);
- $v =~ /^(\d+)\.(\d+)/
- or die "Unparseable Oracle server version: $v\n";
-
-# 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;
-};
-is (
- DBICTest::Schema->connect($dsn, $user, $pass)->storage->_use_insert_returning,
- $test_server_supports_insert_returning,
- 'insert returning capability guessed correctly'
-);
-
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, {
is $query->first->cds_very_very_very_long_relationship_name->first->cdid, 1
} 'query with rel name over 30 chars survived and worked';
+# test rel names over the 30 char limit using group_by and join
+ {
+ my @group_cols = ( 'me.name' );
+ my $query = $schema->resultset('Artist')->search({
+ artistid => 1
+ }, {
+ select => \@group_cols,
+ as => [map { /^\w+\.(\w+)$/ } @group_cols],
+ join => [qw( cds_very_very_very_long_relationship_name )],
+ group_by => \@group_cols,
+ });
+
+ lives_and {
+ my @got = $query->get_column('name')->all();
+ is_deeply \@got, [$new_artist->name];
+ } 'query with rel name over 30 chars worked on join, group_by for me col';
+
+ lives_and {
+ is $query->count(), 1
+ } 'query with rel name over 30 chars worked on join, group_by, count for me col';
+ }
+ {
+ my @group_cols = ( 'cds_very_very_very_long_relationship_name.title' );
+ my $query = $schema->resultset('Artist')->search({
+ artistid => 1
+ }, {
+ select => \@group_cols,
+ as => [map { /^\w+\.(\w+)$/ } @group_cols],
+ join => [qw( cds_very_very_very_long_relationship_name )],
+ group_by => \@group_cols,
+ });
+
+ lives_and {
+ my @got = $query->get_column('title')->all();
+ is_deeply \@got, [$new_cd->title];
+ } 'query with rel name over 30 chars worked on join, group_by for long rel col';
+
+ lives_and {
+ is $query->count(), 1
+ } 'query with rel name over 30 chars worked on join, group_by, count for long rel col';
+ }
+
# rel name over 30 char limit with user condition
# This requires walking the SQLA data structure.
{
- local $TODO = 'user condition on rel longer than 30 chars';
-
$query = $schema->resultset('Artist')->search({
'cds_very_very_very_long_relationship_name.title' => 'EP C'
}, {
$schema->storage->debug (0);
local $TODO = 'Something is confusing column bindtype assignment when quotes are active'
+ . ': https://rt.cpan.org/Ticket/Display.html?id=64206'
if $q;
foreach my $type (qw( blob clob )) {
'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 / blobdiff