1package DBIx::Class::Schema::Loader::DBI::MSSQL; 2 3use strict; 4use warnings; 5use base 'DBIx::Class::Schema::Loader::DBI::Sybase::Common'; 6use Carp::Clan qw/^DBIx::Class/; 7use Class::C3; 8 9our $VERSION = '0.05003'; 10 11=head1 NAME 12 13DBIx::Class::Schema::Loader::DBI::MSSQL - DBIx::Class::Schema::Loader::DBI MSSQL Implementation. 14 15=head1 SYNOPSIS 16 17 package My::Schema; 18 use base qw/DBIx::Class::Schema::Loader/; 19 20 __PACKAGE__->loader_options( debug => 1 ); 21 22 1; 23 24=head1 DESCRIPTION 25 26See L<DBIx::Class::Schema::Loader::Base>. 27 28=cut 29 30sub _setup { 31 my $self = shift; 32 33 $self->next::method(@_); 34 $self->{db_schema} ||= $self->_build_db_schema; 35 $self->_set_quote_char_and_name_sep; 36} 37 38sub _table_pk_info { 39 my ($self, $table) = @_; 40 my $dbh = $self->schema->storage->dbh; 41 my $sth = $dbh->prepare(qq{sp_pkeys '$table'}); 42 $sth->execute; 43 44 my @keydata; 45 46 while (my $row = $sth->fetchrow_hashref) { 47 push @keydata, lc $row->{COLUMN_NAME}; 48 } 49 50 return \@keydata; 51} 52 53sub _table_fk_info { 54 my ($self, $table) = @_; 55 56 my ($local_cols, $remote_cols, $remote_table, @rels); 57 my $dbh = $self->schema->storage->dbh; 58 my $sth = $dbh->prepare(qq{sp_fkeys \@FKTABLE_NAME = '$table'}); 59 $sth->execute; 60 61 while (my $row = $sth->fetchrow_hashref) { 62 my $fk = $row->{FK_NAME}; 63 push @{$local_cols->{$fk}}, lc $row->{FKCOLUMN_NAME}; 64 push @{$remote_cols->{$fk}}, lc $row->{PKCOLUMN_NAME}; 65 $remote_table->{$fk} = $row->{PKTABLE_NAME}; 66 } 67 68 foreach my $fk (keys %$remote_table) { 69 push @rels, { 70 local_columns => \@{$local_cols->{$fk}}, 71 remote_columns => \@{$remote_cols->{$fk}}, 72 remote_table => $remote_table->{$fk}, 73 }; 74 75 } 76 return \@rels; 77} 78 79sub _table_uniq_info { 80 my ($self, $table) = @_; 81 82 my $dbh = $self->schema->storage->dbh; 83 my $sth = $dbh->prepare(qq{SELECT CCU.CONSTRAINT_NAME, CCU.COLUMN_NAME FROM INFORMATION_SCHEMA.CONSTRAINT_COLUMN_USAGE CCU 84 JOIN INFORMATION_SCHEMA.TABLE_CONSTRAINTS TC ON (CCU.CONSTRAINT_NAME = TC.CONSTRAINT_NAME) 85 JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE KCU ON (CCU.CONSTRAINT_NAME = KCU.CONSTRAINT_NAME AND CCU.COLUMN_NAME = KCU.COLUMN_NAME) 86 WHERE CCU.TABLE_NAME = @{[ $dbh->quote($table) ]} AND CONSTRAINT_TYPE = 'UNIQUE' ORDER BY KCU.ORDINAL_POSITION}); 87 $sth->execute; 88 my $constraints; 89 while (my $row = $sth->fetchrow_hashref) { 90 my $name = lc $row->{CONSTRAINT_NAME}; 91 my $col = lc $row->{COLUMN_NAME}; 92 push @{$constraints->{$name}}, $col; 93 } 94 95 my @uniqs = map { [ $_ => $constraints->{$_} ] } keys %$constraints; 96 return \@uniqs; 97} 98 99sub _extra_column_info { 100 my ($self, $info) = @_; 101 my %extra_info; 102 103 my ($table, $column) = @$info{qw/TABLE_NAME COLUMN_NAME/}; 104 105 my $dbh = $self->schema->storage->dbh; 106 my $sth = $dbh->prepare(qq{ 107 SELECT COLUMN_NAME 108 FROM INFORMATION_SCHEMA.COLUMNS 109 WHERE COLUMNPROPERTY(object_id(@{[ $dbh->quote($table) ]}, 'U'), '$column', 'IsIdentity') = 1 110 AND TABLE_NAME = @{[ $dbh->quote($table) ]} AND COLUMN_NAME = @{[ $dbh->quote($column) ]} 111 }); 112 $sth->execute(); 113 114 if ($sth->fetchrow_array) { 115 $extra_info{is_auto_increment} = 1; 116 } 117 118# get default 119 $sth = $dbh->prepare(qq{ 120 SELECT COLUMN_DEFAULT 121 FROM INFORMATION_SCHEMA.COLUMNS 122 WHERE TABLE_NAME = @{[ $dbh->quote($table) ]} AND COLUMN_NAME = @{[ $dbh->quote($column) ]} 123 }); 124 $sth->execute; 125 my ($default) = $sth->fetchrow_array; 126 127 if (defined $default) { 128 # strip parens 129 $default =~ s/^\( (.*) \)\z/$1/x; 130 131 # Literal strings are in ''s, numbers are in ()s (in some versions of 132 # MSSQL, in others they are unquoted) everything else is a function. 133 $extra_info{default_value} = 134 $default =~ /^['(] (.*) [)']\z/x ? $1 : 135 $default =~ /^\d/ ? $default : \$default; 136 } 137 138 return \%extra_info; 139} 140 141=head1 SEE ALSO 142 143L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>, 144L<DBIx::Class::Schema::Loader::DBI> 145 146=head1 AUTHOR 147 148See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>. 149 150=head1 LICENSE 151 152This library is free software; you can redistribute it and/or modify it under 153the same terms as Perl itself. 154 155=cut 156 1571; 158