X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F73oracle.t;h=907c278cd229ab2a58c28b665ca3f356c2471810;hb=81bf295c7883fcbdd988ad64dce62befa80dc4df;hp=eaea830790491d900f0dc85ec23fe7592e6736be;hpb=f116ff4e8c8802234686405ad4ab44bff1a545f6;p=dbsrgits%2FDBIx-Class-Historic.git

diff --git a/t/73oracle.t b/t/73oracle.t
index eaea830..907c278 100644
--- a/t/73oracle.t
+++ b/t/73oracle.t
@@ -4,18 +4,13 @@ use warnings;
 use Test::Exception;
 use Test::More;
 use Sub::Name;
+use Try::Tiny;
+use DBIx::Class::Optional::Dependencies ();
 
 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:
@@ -24,6 +19,13 @@ my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_ORA_EXTRAUSER_${_}" } qw/DSN U
 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;
@@ -49,6 +51,12 @@ plan skip_all => 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test.'
       data_type         => 'integer',
       is_auto_increment => 1,
     },
+    'default_value_col' => {
+      data_type           => 'varchar',
+      size                => 100,
+      is_nullable         => 0,
+      retrieve_on_insert  => 1,
+    }
   );
   __PACKAGE__->set_primary_key(qw/ artistid autoinc_col /);
 
@@ -73,10 +81,10 @@ my $v = do {
   sprintf('%d.%03d', $1, $2);
 };
 
-my $test_server_supports_only_orajoins = $v < 8.001;
+my $test_server_supports_only_orajoins = $v < 9;
 
 # TODO find out which version supports the RETURNING syntax
-# 8i has it and earlier docs are a 404 on oracle.com
+# 8i (8.1) has it and earlier docs are a 404 on oracle.com
 my $test_server_supports_insert_returning = $v >= 8.001;
 
 is (
@@ -86,8 +94,8 @@ is (
 );
 
 ##########
-# recyclebin sometimes comes in the way
-my $on_connect_sql = ["ALTER SESSION SET recyclebin = OFF"];
+# the recyclebin (new for 10g) sometimes comes in the way
+my $on_connect_sql = $v >= 10 ? ["ALTER SESSION SET recyclebin = OFF"] : [];
 
 # iterate all tests on following options
 my @tryopt = (
@@ -172,6 +180,12 @@ sub _run_tests {
   is( $new->artistid, 3, "Oracle Auto-PK worked with fully-qualified tablename" );
   is( $new->autoinc_col, 1000, "Oracle Auto-Inc overruled with fully-qualified tablename");
 
+
+  is( $new->default_value_col, 'default_value', $schema->storage->_use_insert_returning
+    ? 'Check retrieve_on_insert on default_value_col with INSERT ... RETURNING'
+    : 'Check retrieve_on_insert on default_value_col without INSERT ... RETURNING'
+  );
+
   SKIP: {
     skip 'not detecting sequences when using INSERT ... RETURNING', 1
       if $schema->storage->_use_insert_returning;
@@ -337,7 +351,7 @@ sub _run_tests {
   } 'with_deferred_fk_checks code survived';
 
   is eval { $schema->resultset('Track')->find(999)->title }, 'deferred FK track',
-    'code in with_deferred_fk_checks worked'; 
+    'code in with_deferred_fk_checks worked';
 
   throws_ok {
     $schema->resultset('Track')->create({
@@ -363,36 +377,101 @@ sub _run_tests {
     my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
     $binstr{'large'} = $binstr{'small'} x 1024;
 
-    my $maxloblen = length $binstr{'large'};
+    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');
-    my $id = 0;
 
     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', 7;
+      skip 'buggy BLOB support in DBD::Oracle 1.23', 1;
     }
 
     # disable BLOB mega-output
     my $orig_debug = $schema->storage->debug;
-    $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 )) {
-      foreach my $size (qw( small large )) {
-        $id++;
+    my $id;
+    foreach my $size (qw( small large )) {
+      $id++;
 
-        lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
-        "inserted $size $type without dying";
-        ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" );
+      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);
@@ -503,7 +582,7 @@ sub _run_tests {
     skip 'not detecting cross-schema sequence name when using INSERT ... RETURNING', 1
       if $schema->storage->_use_insert_returning;
 
-    # Oracle8i Reference Release 2 (8.1.6) 
+    # Oracle8i Reference Release 2 (8.1.6)
     #   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
@@ -518,6 +597,7 @@ sub _run_tests {
 
     # grand 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);
     $dbh->do("GRANT SELECT ON ${q}artist_autoinc_seq${q} TO " . uc $user2);
 
@@ -599,7 +679,7 @@ sub do_creates {
   # this one is always unquoted as per manually specified sequence =>
   $dbh->do("CREATE SEQUENCE pkid2_seq START WITH 10 MAXVALUE 999999 MINVALUE 0");
 
-  $dbh->do("CREATE TABLE ${q}artist${q} (${q}artistid${q} NUMBER(12), ${q}name${q} VARCHAR(255), ${q}autoinc_col${q} NUMBER(12), ${q}rank${q} NUMBER(38), ${q}charfield${q} VARCHAR2(10))");
+  $dbh->do("CREATE TABLE ${q}artist${q} (${q}artistid${q} NUMBER(12), ${q}name${q} VARCHAR(255),${q}default_value_col${q} VARCHAR(255) DEFAULT 'default_value', ${q}autoinc_col${q} NUMBER(12), ${q}rank${q} NUMBER(38), ${q}charfield${q} VARCHAR2(10))");
   $dbh->do("ALTER TABLE ${q}artist${q} ADD (CONSTRAINT ${q}artist_pk${q} PRIMARY KEY (${q}artistid${q}))");
 
   $dbh->do("CREATE TABLE ${q}sequence_test${q} (${q}pkid1${q} NUMBER(12), ${q}pkid2${q} NUMBER(12), ${q}nonpkid${q} NUMBER(12), ${q}name${q} VARCHAR(255))");