X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F73oracle.t;h=b61a6a8053337fb19472614cbf63846c7b10a108;hb=514b84f6b60b566d75d2ff2ddd08659c4cf7b427;hp=07f1afa2dd9c3cca62d75116511ad553a604df38;hpb=6892eb09b6090628ae4e7092767da0cbff8afcbc;p=dbsrgits%2FDBIx-Class.git

diff --git a/t/73oracle.t b/t/73oracle.t
index 07f1afa..b61a6a8 100644
--- a/t/73oracle.t
+++ b/t/73oracle.t
@@ -1,31 +1,25 @@
+BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
+use DBIx::Class::Optional::Dependencies -skip_all_without => 'test_rdbms_oracle';
+
 use strict;
 use warnings;
 
 use Test::Exception;
 use Test::More;
-use Sub::Name;
 use Try::Tiny;
-use DBIx::Class::Optional::Dependencies ();
+use DBIx::Class::_Util 'set_subname';
 
-use lib qw(t/lib);
 use DBICTest;
-use DBIC::SqlMakerTest;
+
+$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);
-
-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";
-
 {
   package    # hide from PAUSE
     DBICTest::Schema::ArtistFQN;
@@ -74,11 +68,9 @@ 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);
+  my $si = DBICTest::Schema->connect($dsn, $user, $pass)->storage->_server_info;
+  $si->{normalized_dbms_version}
+    or die "Unparseable Oracle server version: $si->{dbms_version}\n";
 };
 
 my $test_server_supports_only_orajoins = $v < 9;
@@ -93,6 +85,13 @@ is (
   'insert returning capability guessed correctly'
 );
 
+isa_ok (DBICTest::Schema->connect($dsn, $user, $pass)->storage->sql_maker, 'DBIx::Class::SQLMaker::Oracle');
+
+# see if determining a driver with bad credentials throws propely
+throws_ok {
+  DBICTest::Schema->connect($dsn, "BORKED BORKED USER $user", $pass)->storage->sql_maker;
+} qr/DBI Connection failed/;
+
 ##########
 # the recyclebin (new for 10g) sometimes comes in the way
 my $on_connect_sql = $v >= 10 ? ["ALTER SESSION SET recyclebin = OFF"] : [];
@@ -112,7 +111,7 @@ for my $use_insert_returning ($test_server_supports_insert_returning ? (1,0) : (
 
     no warnings qw/once redefine/;
     my $old_connection = DBICTest::Schema->can('connection');
-    local *DBICTest::Schema::connection = subname 'DBICTest::Schema::connection' => sub {
+    local *DBICTest::Schema::connection = set_subname 'DBICTest::Schema::connection' => sub {
       my $s = shift->$old_connection (@_);
       $s->storage->_use_insert_returning ($use_insert_returning);
       $s->storage->sql_maker_class('DBIx::Class::SQLMaker::OracleJoins') if $force_ora_joins;
@@ -372,112 +371,6 @@ sub _run_tests {
   is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually");
 
 
-# test BLOBs
-  SKIP: {
-  TODO: {
-    my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
-    $binstr{'large'} = $binstr{'small'} x 1024;
-
-    my $maxloblen = (length $binstr{'large'}) + 5;
-    note "Localizing LongReadLen to $maxloblen to avoid truncation of test data";
-    local $dbh->{'LongReadLen'} = $maxloblen;
-
-    my $rs = $schema->resultset('BindType');
-
-    if ($DBD::Oracle::VERSION eq '1.23') {
-      throws_ok { $rs->create({ id => 1, blob => $binstr{large} }) }
-        qr/broken/,
-        'throws on blob insert with DBD::Oracle == 1.23';
-
-      skip 'buggy BLOB support in DBD::Oracle 1.23', 1;
-    }
-
-    # disable BLOB mega-output
-    my $orig_debug = $schema->storage->debug;
-
-    local $TODO = 'Something is confusing column bindtype assignment when quotes are active'
-                . ': https://rt.cpan.org/Ticket/Display.html?id=64206'
-      if $q;
-
-    my $id;
-    foreach my $size (qw( small large )) {
-      $id++;
-
-      if ($size eq 'small') {
-        $schema->storage->debug($orig_debug);
-      }
-      elsif ($size eq 'large') {
-        $schema->storage->debug(0);
-      }
-
-      my $str = $binstr{$size};
-      lives_ok {
-        $rs->create( { 'id' => $id, blob => "blob:$str", clob => "clob:$str" } )
-      } "inserted $size without dying";
-
-      my %kids = %{$schema->storage->_dbh->{CachedKids}};
-      my @objs = $rs->search({ blob => "blob:$str", clob => "clob:$str" })->all;
-      is_deeply (
-        $schema->storage->_dbh->{CachedKids},
-        \%kids,
-        'multi-part LOB equality query was not cached',
-      ) if $size eq 'large';
-      is @objs, 1, 'One row found matching on both LOBs';
-      ok (try { $objs[0]->blob }||'' eq "blob:$str", 'blob inserted/retrieved correctly');
-      ok (try { $objs[0]->clob }||'' eq "clob:$str", 'clob inserted/retrieved correctly');
-
-      TODO: {
-        local $TODO = '-like comparison on blobs not tested before ora 10 (fails on 8i)'
-          if $schema->storage->_server_info->{normalized_dbms_version} < 10;
-
-        lives_ok {
-          @objs = $rs->search({ clob => { -like => 'clob:%' } })->all;
-          ok (@objs, 'rows found matching CLOB with a LIKE query');
-        } 'Query with like on blob succeeds';
-      }
-
-      ok(my $subq = $rs->search(
-        { blob => "blob:$str", clob => "clob:$str" },
-        {
-          from => \ "(SELECT * FROM ${q}bindtype_test${q} WHERE ${q}id${q} != ?) ${q}me${q}",
-          bind => [ [ undef => 12345678 ] ],
-        }
-      )->get_column('id')->as_query);
-
-      @objs = $rs->search({ id => { -in => $subq } })->all;
-      is (@objs, 1, 'One row found matching on both LOBs as a subquery');
-
-      lives_ok {
-        $rs->search({ id => $id, blob => "blob:$str", clob => "clob:$str" })
-          ->update({ blob => 'updated blob', clob => 'updated clob' });
-      } 'blob UPDATE with blobs in WHERE clause survived';
-
-      @objs = $rs->search({ blob => "updated blob", clob => 'updated clob' })->all;
-      is @objs, 1, 'found updated row';
-      ok (try { $objs[0]->blob }||'' eq "updated blob", 'blob updated/retrieved correctly');
-      ok (try { $objs[0]->clob }||'' eq "updated clob", 'clob updated/retrieved correctly');
-
-      lives_ok {
-        $rs->search({ id => $id  })
-          ->update({ blob => 're-updated blob', clob => 're-updated clob' });
-      } 'blob UPDATE without blobs in WHERE clause survived';
-
-      @objs = $rs->search({ blob => 're-updated blob', clob => 're-updated clob' })->all;
-      is @objs, 1, 'found updated row';
-      ok (try { $objs[0]->blob }||'' eq 're-updated blob', 'blob updated/retrieved correctly');
-      ok (try { $objs[0]->clob }||'' eq 're-updated clob', 'clob updated/retrieved correctly');
-
-      lives_ok {
-        $rs->search({ blob => "re-updated blob", clob => "re-updated clob" })
-          ->delete;
-      } 'blob DELETE with WHERE clause survived';
-      @objs = $rs->search({ blob => "re-updated blob", clob => 're-updated clob' })->all;
-      is @objs, 0, 'row deleted successfully';
-    }
-
-    $schema->storage->debug ($orig_debug);
-  }}
-
 # test populate (identity, success and error handling)
   my $art_rs = $schema->resultset('Artist');
 
@@ -531,13 +424,12 @@ sub _run_tests {
   );
 
 # test complex join (exercise orajoins)
-  lives_ok {
-    my @hri = $schema->resultset('CD')->search(
+  lives_ok { is_deeply (
+    $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 = [{
+    )->all_hri,
+    [{
       artist => 1,
       cdid => 1,
       genreid => undef,
@@ -562,15 +454,9 @@ sub _run_tests {
         },
       ],
       year => 2003
-    }];
-
-    is_deeply (
-      \@hri,
-      $expect,
-      'Correct set of data prefetched',
-    );
-
-  } 'complex prefetch ok';
+    }],
+    'Correct set of data prefetched',
+  ) } 'complex prefetch ok';
 
 # test sequence detection from a different schema
   SKIP: {
@@ -587,7 +473,7 @@ sub _run_tests {
     #   http://download.oracle.com/docs/cd/A87860_01/doc/server.817/a76961/ch294.htm#993
     # Oracle Database Reference 10g Release 2 (10.2)
     #   http://download.oracle.com/docs/cd/B19306_01/server.102/b14237/statviews_2107.htm#sthref1297
-    local $TODO = "On Oracle8i all_triggers view is empty, i don't yet know why..."
+    todo_skip "FIXME: On Oracle8i all_triggers view is empty, i don't yet know why...", 1
       if $schema->storage->_server_info->{normalized_dbms_version} < 9;
 
     my $schema2 = $schema->connect($dsn2, $user2, $pass2, $opt);
@@ -596,7 +482,7 @@ sub _run_tests {
     # create identically named tables/sequences in the other schema
     do_creates($dbh2, $q);
 
-    # grand select privileges to the 2nd user
+    # grant select privileges to the 2nd user
     $dbh->do("GRANT INSERT ON ${q}artist${q} TO " . uc $user2);
     $dbh->do("GRANT SELECT ON ${q}artist${q} TO " . uc $user2);
     $dbh->do("GRANT SELECT ON ${q}artist_pk_seq${q} TO " . uc $user2);
@@ -659,6 +545,26 @@ sub _run_tests {
     do_clean ($dbh2);
   }}
 
+# test driver determination issues that led to the diagnosis/fix in 37b5ab51
+# observed side-effect when count-is-first on a fresh env-based connect
+  {
+    local $ENV{DBI_DSN};
+    ($ENV{DBI_DSN}, my @user_pass_args) = @{ $schema->storage->connect_info };
+    my $s2 = DBICTest::Schema->connect( undef, @user_pass_args );
+    ok (! $s2->storage->connected, 'Not connected' );
+    is (ref $s2->storage, 'DBIx::Class::Storage::DBI', 'Undetermined driver' );
+
+    ok (
+      $s2->resultset('Artist')->search({ 'me.name' => { like => '%' } }, { prefetch => 'cds' })->count,
+      'Some artist count'
+    );
+    ok (
+      scalar $s2->resultset('CD')->search({}, { join => 'tracks' } )->all,
+      'Some cds returned'
+    );
+    $s2->storage->disconnect;
+  }
+
   do_clean ($dbh);
 }
 
@@ -693,8 +599,6 @@ sub do_creates {
   $dbh->do("CREATE TABLE ${q}track${q} (${q}trackid${q} NUMBER(12), ${q}cd${q} NUMBER(12) REFERENCES CD(${q}cdid${q}) DEFERRABLE, ${q}position${q} NUMBER(12), ${q}title${q} VARCHAR(255), ${q}last_updated_on${q} DATE, ${q}last_updated_at${q} DATE)");
   $dbh->do("ALTER TABLE ${q}track${q} ADD (CONSTRAINT ${q}track_pk${q} PRIMARY KEY (${q}trackid${q}))");
 
-  $dbh->do("CREATE TABLE ${q}bindtype_test${q} (${q}id${q} integer NOT NULL PRIMARY KEY, ${q}bytea${q} integer NULL, ${q}blob${q} blob NULL, ${q}clob${q} clob NULL, ${q}a_memo${q} integer NULL)");
-
   $dbh->do(qq{
     CREATE OR REPLACE TRIGGER ${q}artist_insert_trg_auto${q}
     BEFORE INSERT ON ${q}artist${q}
@@ -789,6 +693,7 @@ END {
     next unless $_;
     local $SIG{__WARN__} = sub {};
     do_clean($_);
-    $_->disconnect;
   }
+  undef $dbh;
+  undef $dbh2;
 }