release 0.07027

[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 ae12ded..b5505cb 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.07010';
+our $VERSION = '0.07027';
 
 =head1 NAME
 
@@ -75,12 +75,22 @@ EOF
     return grep !/^(?:#|guest|INFORMATION_SCHEMA|sys)/, @$owners;
 }
 
+sub _current_db {
+    my $self = shift;
+    return ($self->dbh->selectrow_array('SELECT db_name()'))[0];
+}
+
+sub _switch_db {
+    my ($self, $db) = @_;
+    $self->dbh->do("use [$db]");
+}
+
 sub _setup {
     my $self = shift;
 
     $self->next::method(@_);
 
-    my ($current_db) = $self->dbh->selectrow_array('SELECT db_name()');
+    my $current_db = $self->_current_db;
 
     if (ref $self->db_schema eq 'HASH') {
         if (keys %{ $self->db_schema } < 2) {
@@ -168,9 +178,16 @@ EOF
             # XXX why does databasepropertyex() not work over DBD::ODBC ?
             #
             # more on collations here: http://msdn.microsoft.com/en-us/library/ms143515.aspx
-            my ($collation_name) =
-                   eval { $self->dbh->selectrow_array("SELECT collation_name FROM sys.databases WHERE name = @{[ $self->dbh->quote($db) ]}") }
-                || eval { $self->dbh->selectrow_array("SELECT CAST(databasepropertyex(@{[ $self->dbh->quote($db) ]}, 'Collation') AS VARCHAR)") };
+
+            my $current_db = $self->_current_db;
+
+            $self->_switch_db($db);
+
+            my $collation_name =
+                   (eval { $self->dbh->selectrow_array("SELECT collation_name FROM [$db].sys.databases WHERE name = @{[ $self->dbh->quote($db) ]}") })[0]
+                || (eval { $self->dbh->selectrow_array("SELECT CAST(databasepropertyex(@{[ $self->dbh->quote($db) ]}, 'Collation') AS VARCHAR)") })[0];
+
+            $self->_switch_db($current_db);
 
             if (not $collation_name) {
                 warn <<"EOF";
@@ -232,7 +249,7 @@ sub _table_pk_info {
 
     my $db = $table->database;
 
-    return $self->dbh->selectcol_arrayref(<<"EOF")
+    my $pk = $self->dbh->selectcol_arrayref(<<"EOF");
 SELECT kcu.column_name
 FROM [$db].INFORMATION_SCHEMA.TABLE_CONSTRAINTS tc
 JOIN [$db].INFORMATION_SCHEMA.KEY_COLUMN_USAGE kcu
@@ -244,6 +261,10 @@ WHERE tc.table_name = @{[ $self->dbh->quote($table->name) ]}
     AND tc.constraint_type = 'PRIMARY KEY'
 ORDER BY kcu.ordinal_position
 EOF
+
+    $pk = [ map $self->_lc($_), @$pk ];
+
+    return $pk;
 }
 
 sub _table_fk_info {
@@ -279,8 +300,8 @@ EOF
     my %rels;
 
     while (my ($fk, $remote_schema, $remote_table, $col, $remote_col) = $sth->fetchrow_array) {
-        push @{ $rels{$fk}{local_columns}  }, $col;
-        push @{ $rels{$fk}{remote_columns} }, $remote_col;
+        push @{ $rels{$fk}{local_columns}  }, $self->_lc($col);
+        push @{ $rels{$fk}{remote_columns} }, $self->_lc($remote_col);
         
         $rels{$fk}{remote_table} = DBIx::Class::Schema::Loader::Table::Sybase->new(
             loader   => $self,
@@ -330,17 +351,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 column_name = @{[ $self->dbh->quote($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) {
@@ -348,28 +395,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 name = @{[ $self->dbh->quote($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';
         }