FK ON clause introspection for MSSQL

[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / DBI / MSSQL.pm

diff --git a/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm b/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm
index f751fcf..4b1554e 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm
@@ -10,7 +10,7 @@ use namespace::clean;
 
 use DBIx::Class::Schema::Loader::Table::Sybase ();
 
-our $VERSION = '0.07023';
+our $VERSION = '0.07027';
 
 =head1 NAME
 
@@ -273,7 +273,8 @@ sub _table_fk_info {
     my $db = $table->database;
 
     my $sth = $self->dbh->prepare(<<"EOF");
-SELECT rc.constraint_name, rc.unique_constraint_schema, uk_tc.table_name, fk_kcu.column_name, uk_kcu.column_name
+SELECT rc.constraint_name, rc.unique_constraint_schema, uk_tc.table_name,
+       fk_kcu.column_name, uk_kcu.column_name, rc.delete_rule, rc.update_rule
 FROM [$db].INFORMATION_SCHEMA.TABLE_CONSTRAINTS fk_tc
 JOIN [$db].INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS rc
     ON rc.constraint_name = fk_tc.constraint_name
@@ -299,7 +300,8 @@ EOF
 
     my %rels;
 
-    while (my ($fk, $remote_schema, $remote_table, $col, $remote_col) = $sth->fetchrow_array) {
+    while (my ($fk, $remote_schema, $remote_table, $col, $remote_col,
+               $delete_rule, $update_rule) = $sth->fetchrow_array) {
         push @{ $rels{$fk}{local_columns}  }, $self->_lc($col);
         push @{ $rels{$fk}{remote_columns} }, $self->_lc($remote_col);
         
@@ -309,6 +311,12 @@ EOF
             database => $db,
             schema   => $remote_schema,
         ) unless exists $rels{$fk}{remote_table};
+
+        $rels{$fk}{attrs} ||= {
+            on_delete     => uc $delete_rule,
+            on_update     => uc $update_rule,
+            is_deferrable => 1 # constraints can be temporarily disabled, but DEFERRABLE is not supported
+        };
     }
 
     return [ values %rels ];
@@ -351,20 +359,43 @@ sub _columns_info_for {
 
     my $result = $self->next::method(@_);
 
-    while (my ($col, $info) = each %$result) {
-# get type info
-        my ($char_max_length, $data_type, $datetime_precision, $default) =
-            $self->dbh->selectrow_array(<<"EOF");
-SELECT character_maximum_length, data_type, datetime_precision, column_default
-FROM [$db].INFORMATION_SCHEMA.COLUMNS
-WHERE table_name = @{[ $self->dbh->quote($table->name) ]}
-    AND table_schema = @{[ $self->dbh->quote($table->schema) ]}
-    AND @{[ $self->preserve_case ?
-        "column_name = @{[ $self->dbh->quote($col) ]}"
-        :
-        "lower(column_name) = @{[ $self->dbh->quote(lc $col) ]}" ]}
+    # SQL Server: Ancient as time itself, but still out in the wild
+    my $is_2k = $self->schema->storage->_server_info->{normalized_dbms_version} < 9;
+    
+    # get type info (and identity)
+    my $rows = $self->dbh->selectall_arrayref($is_2k ? <<"EOF2K" : <<"EOF");
+SELECT c.column_name, c.character_maximum_length, c.data_type, c.datetime_precision, c.column_default, (sc.status & 0x80) is_identity
+FROM [$db].INFORMATION_SCHEMA.COLUMNS c
+JOIN [$db].dbo.sysusers ss ON
+    c.table_schema = ss.name
+JOIN [$db].dbo.sysobjects so ON
+    c.table_name = so.name
+    AND so.uid = ss.uid
+JOIN [$db].dbo.syscolumns sc ON
+    c.column_name = sc.name
+    AND sc.id = so.Id
+WHERE c.table_schema = @{[ $self->dbh->quote($table->schema) ]}
+    AND c.table_name = @{[ $self->dbh->quote($table->name) ]}
+EOF2K
+SELECT c.column_name, c.character_maximum_length, c.data_type, c.datetime_precision, c.column_default, sc.is_identity
+FROM [$db].INFORMATION_SCHEMA.COLUMNS c
+JOIN [$db].sys.schemas ss ON
+    c.table_schema = ss.name
+JOIN [$db].sys.objects so ON
+      c.table_name   = so.name
+    AND so.schema_id = ss.schema_id
+JOIN [$db].sys.columns sc ON
+    c.column_name = sc.name
+    AND sc.object_id = so.object_id
+WHERE c.table_schema = @{[ $self->dbh->quote($table->schema) ]}
+    AND c.table_name = @{[ $self->dbh->quote($table->name) ]}
 EOF
 
+    foreach my $row (@$rows) {
+        my ($col, $char_max_length, $data_type, $datetime_precision, $default, $is_identity) = @$row;
+        $col = lc $col unless $self->preserve_case;
+        my $info = $result->{$col} || next;
+
         $info->{data_type} = $data_type;
 
         if (defined $char_max_length) {
@@ -372,31 +403,13 @@ EOF
             $info->{size} = 0 if $char_max_length < 0;
         }
 
-# find identities
-        my ($is_identity) = $self->dbh->selectrow_array(<<"EOF");
-SELECT is_identity
-FROM [$db].sys.columns
-WHERE object_id = (
-    SELECT object_id
-    FROM [$db].sys.objects
-    WHERE name = @{[ $self->dbh->quote($table->name) ]}
-        AND schema_id = (
-            SELECT schema_id
-            FROM [$db].sys.schemas
-            WHERE name = @{[ $self->dbh->quote($table->schema) ]}
-        )
-) AND @{[ $self->preserve_case ?
-    "name = @{[ $self->dbh->quote($col) ]}"
-    :
-    "lower(name) = @{[ $self->dbh->quote(lc $col) ]}" ]}
-EOF
         if ($is_identity) {
             $info->{is_auto_increment} = 1;
             $info->{data_type} =~ s/\s*identity//i;
             delete $info->{size};
         }
 
-# fix types
+        # fix types
         if ($data_type eq 'int') {
             $info->{data_type} = 'integer';
         }