introspect ON DELETE/UPDATE FK clauses for DB2

is_deferrable still defaults to 1 because DB2 does not have deferrable
FKs. At some point we will try to implement with_deferred_fk_checks for
DB2 in DBIC.

diff --git a/Changes b/Changes
index 57f72f1..3f119e8 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,10 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
-        - SQLite: introspect ON DELETE/UPDATE and DEFERRABLE clauses
+        - DB2: introspect ON DELETE/UPDATE FK clauses
+        - DB2 WARNING: the default for on_delete/on_update is now 'NO ACTION'
+          not 'CASCADE', the default for is_deferrable is still 1 because DB2
+          does not have deferrable constraints
+        - SQLite: introspect ON DELETE/UPDATE and DEFERRABLE FK clauses
         - SQLite WARNING: the default for on_delete/on_update is now 'NO ACTION'
           not 'CASCADE', and the default for is_deferrable is now 0 not 1.
 

diff --git a/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm b/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm
index 5e05ca5..142f37b 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm
@@ -82,7 +82,7 @@ EOF
     }
 
     $sth->finish;
-    
+
     return \@uniqs;
 }
 
@@ -91,7 +91,8 @@ sub _table_fk_info {
 
     my $sth = $self->{_cache}->{db2_fk} ||= $self->dbh->prepare(<<'EOF');
 SELECT tc.constname, sr.reftabschema, sr.reftabname,
-       kcu.colname, rkcu.colname, kcu.colseq
+       kcu.colname, rkcu.colname, kcu.colseq,
+       sr.deleterule, sr.updaterule
 FROM syscat.tabconst tc
 JOIN syscat.keycoluse kcu
     ON tc.constname = kcu.constname
@@ -112,9 +113,16 @@ EOF
 
     my %rels;
 
+    my %rules = (
+        A => 'NO ACTION',
+        C => 'CASCADE',
+        N => 'SET NULL',
+        R => 'RESTRICT',
+    );
+
     COLS: while (my @row = $sth->fetchrow_array) {
         my ($fk, $remote_schema, $remote_table, $local_col, $remote_col,
-            $colseq) = @row;
+            $colseq, $delete_rule, $update_rule) = @row;
 
         if (not exists $rels{$fk}) {
             if ($self->db_schema && $self->db_schema->[0] ne '%'
@@ -132,6 +140,12 @@ EOF
 
         $rels{$fk}{local_columns}[$colseq-1]  = $self->_lc($local_col);
         $rels{$fk}{remote_columns}[$colseq-1] = $self->_lc($remote_col);
+
+        $rels{$fk}{attrs} ||= {
+            on_delete     => $rules{$delete_rule},
+            on_update     => $rules{$update_rule},
+            is_deferrable => 1, # DB2 has no deferrable constraints
+        };
     }
 
     return [ values %rels ];

diff --git a/t/10_04db2_common.t b/t/10_04db2_common.t
index 30f1257..e0804b8 100644 (file)
--- a/t/10_04db2_common.t
+++ b/t/10_04db2_common.t
@@ -46,6 +46,8 @@ my $tester = dbixcsl_common_tests->new(
     null           => '',
     preserve_case_mode_is_exclusive => 1,
     quote_char                      => '"',
+    default_is_deferrable => 1,
+    default_on_clause => 'NO ACTION',
     data_types => {
         # http://publib.boulder.ibm.com/infocenter/db2luw/v8/index.jsp?topic=/com.ibm.db2.udb.doc/admin/r0008483.htm
         #
@@ -104,11 +106,41 @@ my $tester = dbixcsl_common_tests->new(
 #        datalink           => { data_type => 'datalink' },
     },
     extra => {
-        count => 30 * 2,
+        create => [
+            # 4 through 8 are used for the multi-schema tests
+            q{
+                create table db2_loader_test9 (
+                    id int generated by default as identity not null primary key
+                )
+            },
+            q{
+                create table db2_loader_test10 (
+                    id int generated by default as identity not null primary key,
+                    nine_id int,
+                    foreign key (nine_id) references db2_loader_test9(id)
+                        on delete set null on update restrict
+                )
+            },
+        ],
+        drop  => [ qw/db2_loader_test9 db2_loader_test10/ ],
+        count => 4 + 30 * 2,
         run => sub {
-            SKIP: {
-                $schema = shift;
+            $schema = shift;
+
+            # test on delete/update fk clause introspection
+            ok ((my $rel_info = $schema->source('Db2LoaderTest10')->relationship_info('nine')),
+                'got rel info');
+
+            is $rel_info->{attrs}{on_delete}, 'SET NULL',
+                'ON DELETE clause introspected correctly';
 
+            is $rel_info->{attrs}{on_update}, 'RESTRICT',
+                'ON UPDATE clause introspected correctly';
+
+            is $rel_info->{attrs}{is_deferrable}, 1,
+                'DEFERRABLE defaults to 1';
+
+            SKIP: {
                 my $dbh = $schema->storage->dbh;
 
                 try {