1 package SQL::Translator::Parser::DBI::SQLServer;
3 # -------------------------------------------------------------------
4 # $Id: SQLServer.pm,v 1.3 2006-05-04 20:45:58 duality72 Exp $
5 # -------------------------------------------------------------------
6 # Copyright (C) 2002-4 SQLFairy Authors
8 # This program is free software; you can redistribute it and/or
9 # modify it under the terms of the GNU General Public License as
10 # published by the Free Software Foundation; version 2.
12 # This program is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with this program; if not, write to the Free Software
19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
21 # -------------------------------------------------------------------
25 SQL::Translator::Parser::DBI::SQLServer - parser for SQL Server through DBD::ODBC
29 See SQL::Translator::Parser::DBI.
33 Uses DBI Catalog Methods.
39 use SQL::Translator::Schema;
42 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
43 $VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/;
44 $DEBUG = 0 unless defined $DEBUG;
48 # -------------------------------------------------------------------
50 my ( $tr, $dbh ) = @_;
52 if ($dbh->{FetchHashKeyName} ne 'NAME_uc') {
53 warn "setting dbh attribute {FetchHashKeyName} to NAME_uc";
54 $dbh->{FetchHashKeyName} = 'NAME_uc';
57 if ($dbh->{ChopBlanks} != 1) {
58 warn "setting dbh attribute {ChopBlanks} to 1";
59 $dbh->{ChopBlanks} = 1;
62 my $schema = $tr->schema;
64 my ($sth, @tables, $columns);
69 # it is much quicker to slurp back everything all at once rather
70 # than make repeated calls
72 $sth = $dbh->column_info(undef, undef, undef, undef);
75 foreach my $c (@{$sth->fetchall_arrayref({})}) {
81 ->{$c->{COLUMN_NAME}}= $c;
86 # Get a list of the tables and views.
87 $sth = $dbh->table_info();
88 @tables = @{$sth->fetchall_arrayref({})};
90 my $h = $dbh->selectall_arrayref(q{
91 SELECT o.name, colid,c.text
102 # I had always thought there was something 'hard' about
103 # reconstructing text from syscomments ..
104 # this seems to work fine and is certainly not complicated!
107 $stuff->{view}->{$_->[0]}->{text} .= $_->[2];
110 #### objects with indexes.
112 $stuff->{indexes}->{$_->[0]}++
114 } @{$dbh->selectall_arrayref("SELECT DISTINCT object_name(id)
116 WHERE indid > 0 and indid < 255 and
117 name not like '_WA_Sys%'")};
121 $stuff->{$_->[1]}->{$_->[0]} = $_;
122 } @{$dbh->selectall_arrayref("SELECT name,type, id FROM sysobjects")};
127 # This gets legitimate procedures by used the 'supported' API: sp_stored_procedures
129 my $n = $_->{PROCEDURE_NAME};
130 $n =~ s/;\d+$//; # Ignore versions for now
132 $stuff->{procedures}->{$n} = $_;
133 } values %{$dbh->selectall_hashref("sp_stored_procedures", 'PROCEDURE_NAME')};
136 # And this blasts in the text of 'legit' stored procedures. Do
137 # this rather than calling sp_helptext in a loop.
139 $h = $dbh->selectall_arrayref(q{
140 SELECT o.name, colid,c.text
149 $stuff->{procedures}->{$_->[0]}->{text} .= $_->[2]
150 if (defined($stuff->{procedures}->{$_->[0]}));
159 # Since the 'target' of the trigger is defined in the text, we will
160 # just create them independently for now rather than associating them
163 $h = $dbh->selectall_arrayref(q{
164 SELECT o.name, colid,c.text
169 ON (o.id = o1.instrig OR o.id = o1.deltrig or o.id = o1.updtrig)
176 $stuff->{triggers}->{$_->[0]}->{text} .= $_->[2];
183 # Not sure what to do with these?
184 $stuff->{type_info_all} = $dbh->type_info_all;
187 # According to the DBI docs, these can be
192 # "GLOBAL TEMPORARY",
197 foreach my $table_info (@tables) {
199 unless (defined($table_info->{TABLE_TYPE}));
201 if ($table_info->{TABLE_TYPE} eq "TABLE") {
202 my $table = $schema->add_table(
204 $table_info->{TABLE_NAME},
206 $table_info->{TABLE_TYPE},
207 ) || die $schema->error;
209 # find the associated columns
212 $columns->{$table_info->{TABLE_CAT}}
213 ->{$table_info->{TABLE_SCHEM}}
214 ->{$table_info->{TABLE_NAME}}
217 foreach my $c (values %{$cols}) {
218 my $is_auto_increment = $c->{TYPE_NAME} =~ s#(\(\))? identity##i;
219 my $f = $table->add_field(
220 name => $c->{COLUMN_NAME},
221 data_type => $c->{TYPE_NAME},
222 order => $c->{ORDINAL_POSITION},
223 size => $c->{COLUMN_SIZE},
224 ) || die $table->error;
225 $f->is_nullable($c->{NULLABLE} == 1);
226 $f->is_auto_increment($is_auto_increment);
227 if ( defined $c->{COLUMN_DEF}) {
228 $c->{COLUMN_DEF} =~ s#\('?(.*?)'?\)#$1#;
229 $f->default_value($c->{COLUMN_DEF});
234 my $h = $dbh->selectall_hashref("sp_pkeys
235 $table_info->{TABLE_NAME}", 'COLUMN_NAME');
236 if (scalar keys %{$h} >= 1) {
240 $a->{KEY_SEQ} <=> $b->{KEY_SEQ}
243 $table->primary_key(@c)
247 # add in foreign keys
248 $h = $dbh->selectall_hashref("sp_fkeys NULL,
249 \@fktable_name = '$table_info->{TABLE_NAME}'", 'FK_NAME');
250 foreach my $fk ( values %{$h} ) {
251 my $constraint = $table->add_constraint( name => $fk->{FK_NAME},
252 fields => [$fk->{FKCOLUMN_NAME}],
254 $constraint->type("FOREIGN_KEY");
255 $constraint->on_delete(
256 $fk->{DELETE_RULE} == 0 ? "CASCADE" :
257 $fk->{DELETE_RULE} == 1 ? "NO ACTION" : "SET_NULL"
259 $constraint->on_update(
260 $fk->{UPDATE_RULE} == 0 ? "CASCADE" :
261 $fk->{UPDATE_RULE} == 1 ? "NO ACTION" : "SET_NULL"
263 $constraint->reference_table($fk->{PKTABLE_NAME});
266 # add in any indexes ... how do we tell if the index has
267 # already been created as part of a primary key or other
270 if (defined($stuff->{indexes}->{$table_info->{TABLE_NAME}})){
271 my $h = $dbh->selectall_hashref("sp_helpindex
272 $table_info->{TABLE_NAME}", 'INDEX_NAME');
273 foreach (values %{$h}) {
274 my $fields = $_->{'INDEX_KEYS'};
276 my $i = $table->add_index(
281 if ($_->{'INDEX_DESCRIPTION'} =~ /unique/i) {
284 # we could make this a primary key if there
285 # isn't already one defined and if there
286 # aren't any nullable columns in thisindex.
288 if (!defined($table->primary_key())) {
289 $table->primary_key($fields)
291 $table->get_field($_)->is_nullable()
292 } split(/,\s*/, $fields);
297 } elsif ($table_info->{TABLE_TYPE} eq 'VIEW') {
298 next if $table_info->{TABLE_NAME} eq 'sysconstraints'
299 || $table_info->{TABLE_NAME} eq 'syssegments';
300 my $view = $schema->add_view(
302 $table_info->{TABLE_NAME},
307 $columns->{$table_info->{TABLE_CAT}}
308 ->{$table_info->{TABLE_SCHEM}}
309 ->{$table_info->{TABLE_NAME}}
315 $a->{ORDINAL_POSITION} <=> $b->{ORDINAL_POSITION}
319 $view->sql($stuff->{view}->{$table_info->{TABLE_NAME}}->{text})
320 if (defined($stuff->{view}->{$table_info->{TABLE_NAME}}->{text}));
324 foreach my $p (values %{$stuff->{procedures}}) {
325 my $proc = $schema->add_procedure(
327 owner => $p->{PROCEDURE_OWNER},
328 comments => $p->{REMARKS},
344 # -------------------------------------------------------------------
350 Chris Hilton E<lt>chris@dctank.comE<gt> - Bulk of code from
351 DBI-Sybase parser, I just tweaked it for SQLServer. Thanks.
355 DBI, DBD::ODBC, SQL::Translator::Schema.