From: Rafael Kitover Date: Wed, 24 Mar 2010 22:24:56 +0000 (-0400) Subject: fix case issues for MSSQL X-Git-Tag: 0.06000~31 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=020f3c3ab66a216064907bfcee815f2d77bbb63f;p=dbsrgits%2FDBIx-Class-Schema-Loader.git fix case issues for MSSQL --- diff --git a/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm b/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm index 0fe0dad..e69e4f2 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm @@ -30,9 +30,9 @@ sub _tables_list { my $dbh = $self->schema->storage->dbh; my $sth = $dbh->prepare(<<'EOF'); -select t.table_name -from information_schema.tables t -where t.table_schema = ? +SELECT t.table_name +FROM information_schema.tables t +WHERE t.table_schema = ? EOF $sth->execute($self->db_schema); @@ -68,7 +68,7 @@ sub _table_fk_info { my $fk = $row->{FK_NAME}; push @{$local_cols->{$fk}}, lc $row->{FKCOLUMN_NAME}; push @{$remote_cols->{$fk}}, lc $row->{PKCOLUMN_NAME}; - $remote_table->{$fk} = $row->{PKTABLE_NAME}; + $remote_table->{$fk} = lc $row->{PKTABLE_NAME}; } foreach my $fk (keys %$remote_table) { @@ -86,15 +86,20 @@ sub _table_uniq_info { my ($self, $table) = @_; my $dbh = $self->schema->storage->dbh; - my $sth = $dbh->prepare(qq{SELECT CCU.CONSTRAINT_NAME, CCU.COLUMN_NAME FROM INFORMATION_SCHEMA.CONSTRAINT_COLUMN_USAGE CCU - JOIN INFORMATION_SCHEMA.TABLE_CONSTRAINTS TC ON (CCU.CONSTRAINT_NAME = TC.CONSTRAINT_NAME) - JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE KCU ON (CCU.CONSTRAINT_NAME = KCU.CONSTRAINT_NAME AND CCU.COLUMN_NAME = KCU.COLUMN_NAME) - WHERE CCU.TABLE_NAME = @{[ $dbh->quote($table) ]} AND CONSTRAINT_TYPE = 'UNIQUE' ORDER BY KCU.ORDINAL_POSITION}); + local $dbh->{FetchHashKeyName} = 'NAME_lc'; + + my $sth = $dbh->prepare(qq{ +SELECT ccu.constraint_name, ccu.column_name +FROM information_schema.constraint_column_usage ccu +JOIN information_schema.table_constraints tc on (ccu.constraint_name = tc.constraint_name) +JOIN information_schema.key_column_usage kcu on (ccu.constraint_name = kcu.constraint_name and ccu.column_name = kcu.column_name) +wHERE lower(ccu.table_name) = @{[ $dbh->quote($table) ]} AND constraint_type = 'UNIQUE' ORDER BY kcu.ordinal_position + }); $sth->execute; my $constraints; while (my $row = $sth->fetchrow_hashref) { - my $name = lc $row->{CONSTRAINT_NAME}; - my $col = lc $row->{COLUMN_NAME}; + my $name = $row->{constraint_name}; + my $col = lc $row->{column_name}; push @{$constraints->{$name}}, $col; } @@ -110,15 +115,14 @@ sub _columns_info_for { while (my ($col, $info) = each %$result) { my $dbh = $self->schema->storage->dbh; + my $sth = $dbh->prepare(qq{ - SELECT COLUMN_NAME - FROM INFORMATION_SCHEMA.COLUMNS - WHERE COLUMNPROPERTY(object_id(@{[ $dbh->quote($table) ]}, 'U'), @{[ $dbh->quote($col) ]}, 'IsIdentity') = 1 - AND TABLE_NAME = @{[ $dbh->quote($table) ]} AND COLUMN_NAME = @{[ $dbh->quote($col) ]} +SELECT column_name +FROM information_schema.columns +WHERE columnproperty(object_id(@{[ $dbh->quote($table) ]}, 'U'), @{[ $dbh->quote($col) ]}, 'IsIdentity') = 1 +AND lower(table_name) = @{[ $dbh->quote($table) ]} AND lower(column_name) = @{[ $dbh->quote($col) ]} }); - $sth->execute(); - - if ($sth->fetchrow_array) { + if (eval { $sth->execute; $sth->fetchrow_array }) { $info->{is_auto_increment} = 1; $info->{data_type} =~ s/\s*identity//i; delete $info->{size}; @@ -126,12 +130,11 @@ sub _columns_info_for { # get default $sth = $dbh->prepare(qq{ - SELECT COLUMN_DEFAULT - FROM INFORMATION_SCHEMA.COLUMNS - WHERE TABLE_NAME = @{[ $dbh->quote($table) ]} AND COLUMN_NAME = @{[ $dbh->quote($col) ]} +SELECT column_default +FROM information_schema.columns +wHERE lower(table_name) = @{[ $dbh->quote($table) ]} AND lower(column_name) = @{[ $dbh->quote($col) ]} }); - $sth->execute; - my ($default) = $sth->fetchrow_array; + my ($default) = eval { $sth->execute; $sth->fetchrow_array }; if (defined $default) { # strip parens diff --git a/t/16mssql_common.t b/t/16mssql_common.t index 61a9ffe..114d991 100644 --- a/t/16mssql_common.t +++ b/t/16mssql_common.t @@ -57,17 +57,22 @@ my $tester = dbixcsl_common_tests->new( CREATE VIEW mssql_loader_test4 AS SELECT * FROM mssql_loader_test3 }, - # test capitalization of cols in unique constraints + # test capitalization of cols in unique constraints and rels q{ SET QUOTED_IDENTIFIER ON }, q{ SET ANSI_NULLS ON }, q{ - CREATE TABLE [mssql_loader_test5] ( - [id] INT IDENTITY NOT NULL PRIMARY KEY, + CREATE TABLE [MSSQL_Loader_Test5] ( + [Id] INT IDENTITY NOT NULL PRIMARY KEY, [FooCol] INT NOT NULL, [BarCol] INT NOT NULL, UNIQUE ([FooCol], [BarCol]) ) }, + q{ + CREATE TABLE [MSSQL_Loader_Test6] ( + [Five_Id] INT REFERENCES [MSSQL_Loader_Test5] ([Id]) + ) + }, ], pre_drop_ddl => [ 'CREATE TABLE mssql_loader_test3 (id INT IDENTITY NOT NULL PRIMARY KEY)', @@ -77,8 +82,9 @@ my $tester = dbixcsl_common_tests->new( '[mssql_loader_test1.dot]', 'mssql_loader_test3', 'mssql_loader_test5', + 'mssql_loader_test6', ], - count => 9, + count => 11, run => sub { my ($schema, $monikers, $classes) = @_; @@ -99,7 +105,10 @@ my $tester = dbixcsl_common_tests->new( ok ((my $rsrc = $schema->resultset($monikers->{mssql_loader_test5})->result_source), 'got result_source'); - is $rsrc->column_info('foocol')->{data_type}, 'int', + is $rsrc->name, 'mssql_loader_test5', + 'table name is lowercased'; + + is_deeply [ $rsrc->columns ], [qw/id foocol barcol/], 'column names are lowercased'; my %uniqs = $rsrc->unique_constraints; @@ -108,6 +117,13 @@ my $tester = dbixcsl_common_tests->new( is_deeply ((values %uniqs)[0], [qw/foocol barcol/], 'columns in unique constraint lowercased'); + lives_and { + my $five_row = $schema->resultset($monikers->{mssql_loader_test5})->create({ foocol => 1, barcol => 2 }); + my $six_row = $five_row->create_related('mssql_loader_test6s', {}); + + is $six_row->five->id, 1; + } 'relationships for mixed-case tables/columns detected'; + # Test that a bad view (where underlying table is gone) is ignored. my $dbh = $schema->storage->dbh; $dbh->do("DROP TABLE mssql_loader_test3");