X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI%2FMSSQL.pm;h=bdac624173b4d966e418a022f915a430ea6f60b7;hb=afcd3c328a72efb747e248e0e3df8afc751ae3a1;hp=debfbdea8a8a9c5b558c29b41c3f448b59339c85;hpb=060f5ecdd7c378d4193c5b44e564c952ed9bc4d1;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm b/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm index debfbde..bdac624 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm @@ -3,14 +3,12 @@ package DBIx::Class::Schema::Loader::DBI::MSSQL; use strict; use warnings; use base 'DBIx::Class::Schema::Loader::DBI::Sybase::Common'; +use mro 'c3'; use Carp::Clan qw/^DBIx::Class/; -use Class::C3; +use Try::Tiny; +use namespace::clean; -__PACKAGE__->mk_group_accessors('simple', qw/ - case_sensitive_collation -/); - -our $VERSION = '0.06000'; +our $VERSION = '0.07007'; =head1 NAME @@ -27,18 +25,35 @@ L. See L and L for usage information. -=cut +=head1 CASE SENSITIVITY -sub _is_case_sensitive { - my $self = shift; +Most MSSQL databases use C (case-insensitive) collation, for this reason +generated column names are lower-cased as this makes them easier to work with +in L. - return $self->case_sensitive_collation ? 1 : 0; -} +We attempt to detect the database collation at startup, and set the column +lowercasing behavior accordingly, as lower-cased column names do not work on +case-sensitive databases. + +To manually control case-sensitive mode, put: + + preserve_case => 1|0 + +in your Loader options. + +See L. + +B this option used to be called C, but has +been renamed to a more generic option. + +=cut sub _setup { my $self = shift; - $self->next::method; + $self->next::method(@_); + + return if defined $self->preserve_case; my $dbh = $self->schema->storage->dbh; @@ -47,24 +62,28 @@ sub _setup { # which does not work over DBD::ODBC with unixODBC+FreeTDS. # # 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 { $dbh->selectrow_array('SELECT collation_name FROM sys.databases WHERE name = DB_NAME()') } - || eval { $dbh->selectrow_array("SELECT databasepropertyex(DB_NAME(), 'Collation')") }; + || eval { $dbh->selectrow_array("SELECT CAST(databasepropertyex(DB_NAME(), 'Collation') AS VARCHAR)") }; if (not $collation_name) { - $self->case_sensitive_collation(0); # most likely not - return; - } + warn <<'EOF'; - my ($sensitivity) = $collation_name =~ /(C\w)_[A-z]+\z/; +WARNING: MSSQL Collation detection failed. Defaulting to case-insensitive mode. +Override the 'preserve_case' attribute in your Loader options if needed. - $self->case_sensitive_collation($sensitivity eq 'CS' ? 1 : 0); -} +See 'preserve_case' in +perldoc DBIx::Class::Schema::Loader::Base +EOF + $self->preserve_case(0); + return; + } -sub _lc { - my ($self, $name) = @_; + my $case_sensitive = $collation_name =~ /_(?:CS|BIN2?)(?:_|\z)/; - return $self->case_sensitive_collation ? $name : lc($name); + $self->preserve_case($case_sensitive ? 1 : 0); } sub _tables_list { @@ -74,9 +93,9 @@ sub _tables_list { my $sth = $dbh->prepare(<<'EOF'); SELECT t.table_name FROM INFORMATION_SCHEMA.TABLES t -WHERE lower(t.table_schema) = ? +WHERE t.table_schema = ? EOF - $sth->execute(lc $self->db_schema); + $sth->execute($self->db_schema); my @tables = map @$_, @{ $sth->fetchall_arrayref }; @@ -137,7 +156,7 @@ 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(lc $table) ]} AND constraint_type = 'UNIQUE' ORDER BY kcu.ordinal_position +wHERE ccu.table_name = @{[ $dbh->quote($table) ]} AND constraint_type = 'UNIQUE' ORDER BY kcu.ordinal_position }); $sth->execute; my $constraints; @@ -157,26 +176,87 @@ sub _columns_info_for { my $result = $self->next::method(@_); - while (my ($col, $info) = each %$result) { - my $dbh = $self->schema->storage->dbh; + my $dbh = $self->schema->storage->dbh; + while (my ($col, $info) = each %$result) { +# get type info my $sth = $dbh->prepare(qq{ +SELECT character_maximum_length, data_type, datetime_precision +FROM INFORMATION_SCHEMA.COLUMNS +WHERE table_name = @{[ $dbh->quote($table) ]} AND column_name = @{[ $dbh->quote($col) ]} + }); + $sth->execute; + my ($char_max_length, $data_type, $datetime_precision) = $sth->fetchrow_array; + + $info->{data_type} = $data_type; + + if (defined $char_max_length) { + $info->{size} = $char_max_length; + $info->{size} = 0 if $char_max_length < 0; + } + +# find identities + $sth = $dbh->prepare(qq{ SELECT column_name FROM INFORMATION_SCHEMA.COLUMNS -WHERE columnproperty(object_id(@{[ $dbh->quote(lc $table) ]}, 'U'), @{[ $dbh->quote(lc $col) ]}, 'IsIdentity') = 1 -AND lower(table_name) = @{[ $dbh->quote(lc $table) ]} AND lower(column_name) = @{[ $dbh->quote(lc $col) ]} +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) ]} }); - if (eval { $sth->execute; $sth->fetchrow_array }) { + if (try { $sth->execute; $sth->fetchrow_array }) { $info->{is_auto_increment} = 1; $info->{data_type} =~ s/\s*identity//i; delete $info->{size}; } +# fix types + if ($data_type eq 'int') { + $info->{data_type} = 'integer'; + } + elsif ($data_type eq 'timestamp') { + $info->{inflate_datetime} = 0; + } + elsif ($data_type =~ /^(?:numeric|decimal)\z/) { + if (ref($info->{size}) && $info->{size}[0] == 18 && $info->{size}[1] == 0) { + delete $info->{size}; + } + } + elsif ($data_type eq 'float') { + $info->{data_type} = 'double precision'; + delete $info->{size}; + } + elsif ($data_type =~ /^(?:small)?datetime\z/) { + # fixup for DBD::Sybase + if ($info->{default_value} && $info->{default_value} eq '3') { + delete $info->{default_value}; + } + } + elsif ($data_type =~ /^(?:datetime(?:2|offset)|time)\z/) { + $info->{size} = $datetime_precision; + + delete $info->{size} if $info->{size} == 7; + } + elsif ($data_type eq 'varchar' && $info->{size} == 0) { + $info->{data_type} = 'text'; + delete $info->{size}; + } + elsif ($data_type eq 'nvarchar' && $info->{size} == 0) { + $info->{data_type} = 'ntext'; + delete $info->{size}; + } + elsif ($data_type eq 'varbinary' && $info->{size} == 0) { + $info->{data_type} = 'image'; + delete $info->{size}; + } + + if ($data_type !~ /^(?:n?char|n?varchar|binary|varbinary|numeric|decimal|float|datetime(?:2|offset)|time)\z/) { + delete $info->{size}; + } + # get default $sth = $dbh->prepare(qq{ SELECT column_default FROM INFORMATION_SCHEMA.COLUMNS -wHERE lower(table_name) = @{[ $dbh->quote(lc $table) ]} AND lower(column_name) = @{[ $dbh->quote(lc $col) ]} +wHERE table_name = @{[ $dbh->quote($table) ]} AND column_name = @{[ $dbh->quote($col) ]} }); my ($default) = eval { $sth->execute; $sth->fetchrow_array }; @@ -189,6 +269,13 @@ wHERE lower(table_name) = @{[ $dbh->quote(lc $table) ]} AND lower(column_name) = $info->{default_value} = $default =~ /^['(] (.*) [)']\z/x ? $1 : $default =~ /^\d/ ? $default : \$default; + + if ((eval { lc ${ $info->{default_value} } }||'') eq 'getdate()') { + ${ $info->{default_value} } = 'current_timestamp'; + + my $getdate = 'getdate()'; + $info->{original}{default_value} = \$getdate; + } } }