introspect ON DELETE/UPDATE for SQL Anywhere

The default seems to be RESTRICT, but it's hard to tell, because the
actions are implemented as triggers and you have to query the catalog
triggers view to get at them. At least if you specify RESTRICT there is
no trigger generated.

SQL Anywhere does not support DEFERRABLE constraints. It has something
called CHECK ON COMMIT but that does not seem to have the same full
functionality, so for now we leave is_deferrable at 1.

diff --git a/Changes b/Changes
index 8a706d5..b378bb3 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - SQL Anywhere: introspect ON DELETE/UPDATE rules, default is now
+          RESTRICT. is_deferrable still defaults to 1
         - rewrite pg fk introspection to use catalog views instead of
           information_schema as information_schema does not work for readonly
           users

diff --git a/lib/DBIx/Class/Schema/Loader/DBI/SQLAnywhere.pm b/lib/DBIx/Class/Schema/Loader/DBI/SQLAnywhere.pm
index 014ce5f..0e5adbb 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/DBI/SQLAnywhere.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/SQLAnywhere.pm
@@ -165,13 +165,26 @@ sub _table_pk_info {
     return \@keydata;
 }
 
+my %sqlany_rules = (
+    C => 'CASCADE',
+    D => 'SET DEFAULT',
+    N => 'SET NULL',
+    R => 'RESTRICT',
+);
+
 sub _table_fk_info {
     my ($self, $table) = @_;
 
-    my ($local_cols, $remote_cols, $remote_table, @rels);
+    my ($local_cols, $remote_cols, $remote_table, $attrs, @rels);
     my $sth = $self->dbh->prepare(<<'EOF');
-SELECT fki.index_name fk_name, fktc.column_name local_column, pku.user_name remote_schema, pkt.table_name remote_table, pktc.column_name remote_column
+SELECT fki.index_name fk_name, fktc.column_name local_column, pku.user_name remote_schema, pkt.table_name remote_table, pktc.column_name remote_column, on_delete.referential_action, on_update.referential_action
 FROM sysfkey fk
+JOIN (
+    select foreign_table_id, foreign_index_id,
+           row_number() over (partition by foreign_table_id order by foreign_index_id) foreign_key_num
+    from sysfkey
+) fkid
+    ON fkid.foreign_table_id = fk.foreign_table_id and fkid.foreign_index_id = fk.foreign_index_id
 JOIN systab    pkt
     ON fk.primary_table_id = pkt.table_id
 JOIN sysuser   pku
@@ -190,18 +203,39 @@ JOIN systabcol pktc
     ON pkt.table_id        = pktc.table_id AND fkic.primary_column_id = pktc.column_id
 JOIN systabcol fktc
     ON fkt.table_id        = fktc.table_id AND fkic.column_id         = fktc.column_id
+LEFT JOIN systrigger on_delete
+    ON on_delete.foreign_table_id = fkt.table_id AND on_delete.foreign_key_id = fkid.foreign_key_num
+    AND on_delete.event = 'D'
+LEFT JOIN systrigger on_update
+    ON on_update.foreign_table_id = fkt.table_id AND on_update.foreign_key_id = fkid.foreign_key_num
+    AND on_update.event = 'C'
 WHERE fku.user_name = ? AND fkt.table_name = ?
+ORDER BY fk.primary_table_id, pktc.column_id
 EOF
     $sth->execute($table->schema, $table->name);
 
-    while (my ($fk, $local_col, $remote_schema, $remote_tab, $remote_col) = $sth->fetchrow_array) {
+    while (my ($fk, $local_col, $remote_schema, $remote_tab, $remote_col, $on_delete, $on_update)
+            = $sth->fetchrow_array) {
+
         push @{$local_cols->{$fk}},  $self->_lc($local_col);
+
         push @{$remote_cols->{$fk}}, $self->_lc($remote_col);
+
         $remote_table->{$fk} = DBIx::Class::Schema::Loader::Table->new(
             loader  => $self,
             name    => $remote_tab,
             schema  => $remote_schema,
         );
+
+        $attrs->{$fk} ||= {
+            on_delete => $sqlany_rules{$on_delete||''} || 'RESTRICT',
+            on_update => $sqlany_rules{$on_update||''} || 'RESTRICT',
+# We may be able to use the value of the 'CHECK ON COMMIT' option, as it seems
+# to be some sort of workaround for lack of deferred constraints. Unclear on
+# how good of a substitute it is, and it requires the 'RESTRICT' rule. Also it
+# only works for INSERT and UPDATE, not DELETE. Will get back to this.
+            is_deferrable => 1,
+        };
     }
 
     foreach my $fk (keys %$remote_table) {
@@ -209,6 +243,7 @@ EOF
             local_columns => $local_cols->{$fk},
             remote_columns => $remote_cols->{$fk},
             remote_table => $remote_table->{$fk},
+            attrs => $attrs->{$fk},
         };
     }
     return \@rels;

diff --git a/t/10_08sqlanywhere_common.t b/t/10_08sqlanywhere_common.t
index a626b86..c3299b5 100644 (file)
--- a/t/10_08sqlanywhere_common.t
+++ b/t/10_08sqlanywhere_common.t
@@ -44,6 +44,8 @@ my $tester = dbixcsl_common_tests->new(
         } : ()),
     ],
     loader_options => { preserve_case => 1 },
+    default_is_deferrable => 1,
+    default_on_clause => 'RESTRICT',
     data_types  => {
         # http://infocenter.sybase.com/help/topic/com.sybase.help.sqlanywhere.11.0.1/dbreference_en11/rf-datatypes.html
         #
@@ -144,12 +146,42 @@ my $tester = dbixcsl_common_tests->new(
         'ntext'        => { data_type => 'ntext' },
     },
     extra => {
-        count => 30 * 2,
+        create => [
+            # 4 through 8 are used for the multi-schema tests
+            q{
+                create table sqlanywhere_loader_test9 (
+                    id int identity not null primary key
+                )
+            },
+            q{
+                create table sqlanywhere_loader_test10 (
+                    id int identity not null primary key,
+                    nine_id int,
+                    foreign key (nine_id) references sqlanywhere_loader_test9(id)
+                        on delete cascade on update set null
+                )
+            },
+        ],
+        drop  => [ qw/sqlanywhere_loader_test9 sqlanywhere_loader_test10/ ],
+        count => 4 + 30 * 2,
         run => sub {
             SKIP: {
                 $schema  = $_[0];
                 my $self = $_[3];
 
+                # test on delete/update fk clause introspection
+                ok ((my $rel_info = $schema->source('SqlanywhereLoaderTest10')->relationship_info('nine')),
+                    'got rel info');
+
+                is $rel_info->{attrs}{on_delete}, 'CASCADE',
+                    'ON DELETE clause introspected correctly';
+
+                is $rel_info->{attrs}{on_update}, 'SET NULL',
+                    'ON UPDATE clause introspected correctly';
+
+                is $rel_info->{attrs}{is_deferrable}, 1,
+                    'is_deferrable defaults to 1';
+
                 my $connect_info = [@$self{qw/dsn user password/}];
 
                 my $dbh = $schema->storage->dbh;