From: Rafael Kitover Date: Wed, 28 Mar 2012 00:16:08 +0000 (-0400) Subject: audit drivers for case issues (RT#75805) X-Git-Tag: 0.07019~1 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=116431d67fe62da10229791aef6cc0d5a87802d9;hp=18eb280f9b71785a12c105299f813358faa47143;p=dbsrgits%2FDBIx-Class-Schema-Loader.git audit drivers for case issues (RT#75805) Add missing ->_lc calls to MSSQL driver in _table_pk_info and _table_fk_info, and rework use of column name in queries in _columns_info_for based on the value of _preserve_case. This fixes the RT in question, as tested with the DDL provided by the reporter. Fix collation detection in MSSQL driver when in a database other than master by changing 'sys.databases' to '[$db].sys.databases' and doing a "use [$db]" beforehand (with a warning silencing fixup for ADO.) Check for collisions of columns like 'Foo' and 'fOO' in preserve_case=0 mode in ::DBI::_columns_info_for and throw an exception if detected. UNRELATED CLEANUP: Remove warning fixups for _table_comment and _column_comment from Access and MSSQL ADO drivers as we now check for the existance of the comment tables. Add missing ->_lc call in Pg _table_uniq_info, which was only for very old versions of DBD::Pg anyway. In _columns_info_for in the SQL Anywhere driver, fold the column names in queries to lower case, as SQL Anywhere is case preserving, but not case sensitive. In _columns_info_for in the SQLite driver, map the column names from the table_info pragma to the ->_lc versions. Fold column names to lowercase in the mysql driver's _columns_info_for as MySQL is case preserving but not case sensitive for column names. --- diff --git a/Changes b/Changes index 48d0860..e4e82fa 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,7 @@ Revision history for Perl extension DBIx::Class::Schema::Loader + - fix some errors due to case issues (RT#75805) + 0.07018 2012-03-27 05:55:10 - skip dbicdump tests on Win32 due to test fails (RT#75732) - fix undefined warnings for DBDs without schemas diff --git a/lib/DBIx/Class/Schema/Loader/DBI.pm b/lib/DBIx/Class/Schema/Loader/DBI.pm index 91a6c7e..13de355 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI.pm @@ -6,6 +6,7 @@ use base qw/DBIx::Class::Schema::Loader::Base/; use mro 'c3'; use Try::Tiny; use List::MoreUtils 'any'; +use Carp::Clan qw/^DBIx::Class/; use namespace::clean; use DBIx::Class::Schema::Loader::Table (); @@ -467,8 +468,6 @@ sub _columns_info_for { my $col_name = $info->{COLUMN_NAME}; $col_name =~ s/^\"(.*)\"$/$1/; - $col_name = $self->_lc($col_name); - my $extra_info = $self->_extra_column_info( $table, $col_name, $column_info, $info ) || {}; @@ -509,7 +508,7 @@ sub _columns_info_for { my $extra_info = $self->_extra_column_info($table, $columns[$i], $column_info, $sth) || {}; $column_info = { %$column_info, %$extra_info }; - $result{ $self->_lc($columns[$i]) } = $column_info; + $result{ $columns[$i] } = $column_info; } $sth->finish; @@ -523,6 +522,32 @@ sub _columns_info_for { } } + # check for instances of the same column name with different case in preserve_case=0 mode + if (not $self->preserve_case) { + my %lc_colnames; + + foreach my $col (keys %result) { + push @{ $lc_colnames{lc $col} }, $col; + } + + if (keys %lc_colnames != keys %result) { + my @offending_colnames = map @$_, grep @$_ > 1, values %lc_colnames; + + my $offending_colnames = join ", ", map "'$_'", @offending_colnames; + + croak "columns $offending_colnames in table @{[ $table->sql_name ]} collide in preserve_case=0 mode. preserve_case=1 mode required"; + } + + # apply lowercasing + my %lc_result; + + while (my ($col, $info) = each %result) { + $lc_result{ $self->_lc($col) } = $info; + } + + %result = %lc_result; + } + return \%result; } diff --git a/lib/DBIx/Class/Schema/Loader/DBI/ADO/MS_Jet.pm b/lib/DBIx/Class/Schema/Loader/DBI/ADO/MS_Jet.pm index c957710..5dd48f2 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/ADO/MS_Jet.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/ADO/MS_Jet.pm @@ -191,33 +191,6 @@ sub _columns_info_for { return $result; } -# Trap and ignore OLE warnings from nonexistant comments tables. - -sub _table_comment { - my $self = shift; - - my $warn_handler = $SIG{__WARN__} || sub { warn @_ }; - - local $SIG{__WARN__} = sub { - $warn_handler->(@_) unless $_[0] =~ /cannot find the input table/; - }; - - $self->next::method(@_); -} - -sub _column_comment { - my $self = shift; - - my $warn_handler = $SIG{__WARN__} || sub { warn @_ }; - - local $SIG{__WARN__} = sub { - $warn_handler->(@_) unless $_[0] =~ /cannot find the input table/; - }; - - $self->next::method(@_); -} - - =head1 SEE ALSO L, diff --git a/lib/DBIx/Class/Schema/Loader/DBI/ADO/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Schema/Loader/DBI/ADO/Microsoft_SQL_Server.pm index 551a549..a74268d 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/ADO/Microsoft_SQL_Server.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/ADO/Microsoft_SQL_Server.pm @@ -23,14 +23,14 @@ See L for usage information. =cut -sub _table_comment { - local $^W = 0; # invalid object warnings - shift->next::method(@_); -} - -sub _column_comment { - local $^W = 0; # invalid object warnings - shift->next::method(@_); +# Silence ADO "Changed database context" warnings +sub _switch_db { + my $self = shift; + my $warn_handler = $SIG{__WARN__} || sub { warn @_ }; + local $SIG{__WARN__} = sub { + $warn_handler->(@_) unless $_[0] =~ /Changed database context/; + }; + return $self->next::method(@_); } =head1 SEE ALSO diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Informix.pm b/lib/DBIx/Class/Schema/Loader/DBI/Informix.pm index 1e26307..9d378dd 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/Informix.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/Informix.pm @@ -240,7 +240,7 @@ EOF sub _idx_colnames { my ($self, $idx_info, $table_cols_by_colno) = @_; - return [ map $self->_lc($table_cols_by_colno->{$_}), grep $_, map $idx_info->{$_}, map "part$_", (1..16) ]; + return [ map $table_cols_by_colno->{$_}, grep $_, map $idx_info->{$_}, map "part$_", (1..16) ]; } sub _colnames_by_colno { @@ -259,7 +259,7 @@ WHERE t.tabname = ? EOF $sth->execute($table); my $cols = $sth->fetchall_hashref('colno'); - $cols = { map +($_, $cols->{$_}{colname}), keys %$cols }; + $cols = { map +($_, $self->_lc($cols->{$_}{colname})), keys %$cols }; return $cols; } diff --git a/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm b/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm index d76ef9a..0653228 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm @@ -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, @@ -338,7 +359,10 @@ 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) ]} + AND @{[ $self->preserve_case ? + "column_name = @{[ $self->dbh->quote($col) ]}" + : + "lower(column_name) = @{[ $self->dbh->quote(lc $col) ]}" ]} EOF $info->{data_type} = $data_type; @@ -361,7 +385,10 @@ WHERE object_id = ( FROM [$db].sys.schemas WHERE name = @{[ $self->dbh->quote($table->schema) ]} ) -) AND name = @{[ $self->dbh->quote($col) ]} +) 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; diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm b/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm index 3841199..95dd8f4 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm @@ -78,7 +78,7 @@ sub _table_uniq_info { c.relname = ?} ); - $uniq_sth->execute($table->schema, $table); + $uniq_sth->execute($table->schema, $table->name); while(my $row = $uniq_sth->fetchrow_arrayref) { my ($tableid, $indexname, $col_nums) = @$row; $col_nums =~ s/^\s+//; @@ -88,7 +88,7 @@ sub _table_uniq_info { foreach (@col_nums) { $attr_sth->execute($tableid, $_); my $name_aref = $attr_sth->fetchrow_arrayref; - push(@col_names, $name_aref->[0]) if $name_aref; + push(@col_names, $self->_lc($name_aref->[0])) if $name_aref; } if(!@col_names) { @@ -164,7 +164,7 @@ sub _columns_info_for { } my ($precision) = $self->schema->storage->dbh - ->selectrow_array(<selectrow_array(<name, $col); SELECT datetime_precision FROM information_schema.columns WHERE table_name = ? and column_name = ? @@ -199,7 +199,7 @@ EOF elsif ($data_type =~ /^(?:bit(?: varying)?|varbit)\z/i) { $info->{data_type} = 'varbit' if $data_type =~ /var/i; - my ($precision) = $self->dbh->selectrow_array(<dbh->selectrow_array(<name, $col); SELECT character_maximum_length FROM information_schema.columns WHERE table_name = ? and column_name = ? diff --git a/lib/DBIx/Class/Schema/Loader/DBI/SQLAnywhere.pm b/lib/DBIx/Class/Schema/Loader/DBI/SQLAnywhere.pm index bedb371..e53d7c9 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/SQLAnywhere.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/SQLAnywhere.pm @@ -94,7 +94,7 @@ sub _columns_info_for { $info->{is_auto_increment} = 1; } - my ($user_type) = $dbh->selectrow_array(<<'EOF', {}, $table->schema, $table->name, $col); + my ($user_type) = $dbh->selectrow_array(<<'EOF', {}, $table->schema, $table->name, lc($col)); SELECT ut.type_name FROM systabcol tc JOIN systab t @@ -103,7 +103,7 @@ JOIN sysuser u ON t.creator = u.user_id JOIN sysusertype ut ON tc.user_type = ut.type_id -WHERE u.user_name = ? AND t.table_name = ? AND tc.column_name = ? +WHERE u.user_name = ? AND t.table_name = ? AND lower(tc.column_name) = ? EOF $info->{data_type} = $user_type if defined $user_type; @@ -125,9 +125,9 @@ JOIN systab t ON t.table_id = tc.table_id JOIN sysuser u ON t.creator = u.user_id -WHERE u.user_name = ? AND t.table_name = ? AND tc.column_name = ? +WHERE u.user_name = ? AND t.table_name = ? AND lower(tc.column_name) = ? EOF - $sth->execute($table->schema, $table->name, $col); + $sth->execute($table->schema, $table->name, lc($col)); my ($width, $scale) = $sth->fetchrow_array; $sth->finish; diff --git a/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm b/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm index 82a1073..aa207eb 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm @@ -71,15 +71,22 @@ sub _columns_info_for { $sth->execute; my $cols = $sth->fetchall_hashref('name'); + # copy and case according to preserve_case mode + # no need to check for collisions, SQLite does not allow them + my %cols; + while (my ($col, $info) = each %$cols) { + $cols{ $self->_lc($col) } = $info; + } + my ($num_pk, $pk_col) = (0); # SQLite doesn't give us the info we need to do this nicely :( # If there is exactly one column marked PK, and its type is integer, # set it is_auto_increment. This isn't 100%, but it's better than the # alternatives. while (my ($col_name, $info) = each %$result) { - if ($cols->{$col_name}{pk}) { - $num_pk ++; - if (lc($cols->{$col_name}{type}) eq 'integer') { + if ($cols{$col_name}{pk}) { + $num_pk++; + if (lc($cols{$col_name}{type}) eq 'integer') { $pk_col = $col_name; } } diff --git a/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm b/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm index 4d1bee8..15efc62 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm @@ -201,10 +201,10 @@ sub _columns_info_for { delete $info->{size} if $data_type !~ /^(?: (?:var)?(?:char(?:acter)?|binary) | bit | year)\z/ix; # information_schema is available in 5.0+ - my ($precision, $scale, $column_type, $default) = eval { $self->dbh->selectrow_array(<<'EOF', {}, $table, $col) }; + my ($precision, $scale, $column_type, $default) = eval { $self->dbh->selectrow_array(<<'EOF', {}, $table->name, lc($col)) }; SELECT numeric_precision, numeric_scale, column_type, column_default FROM information_schema.columns -WHERE table_name = ? AND column_name = ? +WHERE table_name = ? AND lower(column_name) = ? EOF my $has_information_schema = not $@; @@ -307,7 +307,7 @@ sub _table_comment { FROM information_schema.tables WHERE table_schema = schema() AND table_name = ? - }, undef, $table); + }, undef, $table->name); }; # InnoDB likes to auto-append crap. if (not $comment) { @@ -332,8 +332,8 @@ sub _column_comment { FROM information_schema.columns WHERE table_schema = schema() AND table_name = ? - AND column_name = ? - }, undef, $table, $column_name); + AND lower(column_name) = ? + }, undef, $table->name, lc($column_name)); }; } return $comment;