X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI%2FMSSQL.pm;h=e2810f29818fb284ddec2dce6eb58b7386a7c3ff;hb=306bf770bf08b06f92863808b1938f2fc704acb0;hp=83b0576159c818964960e58d3a261b33e9ccf8d6;hpb=bb46cd4b8d2cf185f37b632bc339d9669267c7fb;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 83b0576..e2810f2 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm @@ -5,12 +5,12 @@ use warnings; use base 'DBIx::Class::Schema::Loader::DBI::Sybase::Common'; use mro 'c3'; use Try::Tiny; -use List::MoreUtils 'any'; +use List::Util 'any'; use namespace::clean; use DBIx::Class::Schema::Loader::Table::Sybase (); -our $VERSION = '0.07021'; +our $VERSION = '0.07047'; =head1 NAME @@ -51,6 +51,11 @@ been renamed to a more generic option. =cut +# SQL Server 2000: Ancient as time itself, but still out in the wild +sub _is_2k { + return shift->schema->storage->_server_info->{normalized_dbms_version} < 9; +} + sub _system_databases { return (qw/ master model tempdb msdb @@ -63,18 +68,31 @@ sub _system_tables { /); } -sub _owners { +sub _schemas { my ($self, $db) = @_; - my $owners = $self->dbh->selectcol_arrayref(<<"EOF"); + my $owners = $self->dbh->selectcol_arrayref($self->_is_2k ? <<"EOF2K" : <<"EOF"); SELECT name FROM [$db].dbo.sysusers WHERE uid <> gid +EOF2K +SELECT name +FROM [$db].sys.schemas EOF return grep !/^(?:#|guest|INFORMATION_SCHEMA|sys)/, @$owners; } +sub _current_schema { + my $self = shift; + + if ($self->_is_2k) { + return ($self->dbh->selectrow_array('SELECT user_name()'))[0]; + } + + return ($self->dbh->selectrow_array('SELECT schema_name()'))[0]; +} + sub _current_db { my $self = shift; return ($self->dbh->selectrow_array('SELECT db_name()'))[0]; @@ -142,7 +160,7 @@ EOF } else { if ($db ne $current_db) { - $self->dbh->do("USE [$db]"); + $self->_switch_db($db); $self->qualify_objects(1); } @@ -154,7 +172,7 @@ EOF } elsif (ref $self->db_schema eq 'ARRAY' || (not defined $self->db_schema)) { my $owners = $self->db_schema; - $owners ||= [ $self->dbh->selectrow_array('SELECT user_name()') ]; + $owners ||= [ $self->_current_schema ]; $self->qualify_objects(1) if @$owners > 1; @@ -163,7 +181,7 @@ EOF foreach my $db (keys %{ $self->db_schema }) { if ($self->db_schema->{$db} eq '%') { - $self->db_schema->{$db} = [ $self->_owners($db) ]; + $self->db_schema->{$db} = [ $self->_schemas($db) ]; $self->qualify_objects(1); } @@ -216,7 +234,7 @@ EOF } sub _tables_list { - my ($self, $opts) = @_; + my ($self) = @_; my @tables; @@ -241,7 +259,7 @@ EOF } } - return $self->_filter_tables(\@tables, $opts); + return $self->_filter_tables(\@tables); } sub _table_pk_info { @@ -273,7 +291,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 @@ -281,7 +300,7 @@ JOIN [$db].INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS rc JOIN [$db].INFORMATION_SCHEMA.KEY_COLUMN_USAGE fk_kcu ON fk_kcu.constraint_name = fk_tc.constraint_name AND fk_kcu.table_name = fk_tc.table_name - AND fk_kcu.table_schema = fk_tc.table_schema + AND fk_kcu.table_schema = fk_tc.table_schema JOIN [$db].INFORMATION_SCHEMA.TABLE_CONSTRAINTS uk_tc ON uk_tc.constraint_name = rc.unique_constraint_name AND uk_tc.table_schema = rc.unique_constraint_schema @@ -299,16 +318,23 @@ 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); - + $rels{$fk}{remote_table} = DBIx::Class::Schema::Loader::Table::Sybase->new( loader => $self, name => $remote_table, 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 ]; @@ -340,7 +366,7 @@ EOF push @{ $uniq{$constr} }, $self->_lc($col); } - return [ map [ $_ => $uniq{$_} ], keys %uniq ]; + return [ map [ $_ => $uniq{$_} ], sort keys %uniq ]; } sub _columns_info_for { @@ -351,20 +377,40 @@ 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) ]}" ]} + # get type info (and identity) + my $rows = $self->dbh->selectall_arrayref($self->_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 +418,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'; } @@ -469,9 +497,9 @@ L, L, L, L -=head1 AUTHOR +=head1 AUTHORS -See L and L. +See L. =head1 LICENSE