check database driver dependencies for tests
[dbsrgits/DBIx-Class.git] / t / 73oracle.t
index 84847ae..aafd1f0 100644 (file)
@@ -4,6 +4,8 @@ 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;
@@ -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 /);
 
@@ -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,19 +377,18 @@ 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
@@ -386,14 +399,63 @@ sub _run_tests {
                 . ': https://rt.cpan.org/Ticket/Display.html?id=64206'
       if $q;
 
-    foreach my $type (qw( blob clob )) {
-      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" );
+    my $id;
+    foreach my $size (qw( small large )) {
+      $id++;
+
+      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({ blob => "blob:$str", clob => "clob:$str" })
+          ->update({ blob => 'updated blob', clob => 'updated clob' });
+      } 'blob UPDATE with 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({ blob => "updated blob", clob => "updated clob" })
+          ->delete;
+      } 'blob DELETE with WHERE clause survived';
+      @objs = $rs->search({ blob => "updated blob", clob => 'updated clob' })->all;
+      is @objs, 0, 'row deleted successfully';
     }
 
     $schema->storage->debug ($orig_debug);
@@ -504,7 +566,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
@@ -519,6 +581,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);
 
@@ -600,7 +663,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))");