From: Chris Hilton Date: Mon, 27 Jun 2005 19:00:19 +0000 (+0000) Subject: A DBI Parser for SQL Server, mostly copied from DBI/Sybase X-Git-Tag: v0.11008~532 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4eb28bc31cdc1d754b7a853e7bd00244b683e7cb;p=dbsrgits%2FSQL-Translator.git A DBI Parser for SQL Server, mostly copied from DBI/Sybase --- diff --git a/lib/SQL/Translator/Parser/DBI/SQLServer.pm b/lib/SQL/Translator/Parser/DBI/SQLServer.pm new file mode 100644 index 0000000..cb2eb4e --- /dev/null +++ b/lib/SQL/Translator/Parser/DBI/SQLServer.pm @@ -0,0 +1,355 @@ +package SQL::Translator::Parser::DBI::SQLServer; + +# ------------------------------------------------------------------- +# $Id: SQLServer.pm,v 1.1 2005-06-27 19:00:19 duality72 Exp $ +# ------------------------------------------------------------------- +# Copyright (C) 2002-4 SQLFairy Authors +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License as +# published by the Free Software Foundation; version 2. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +# 02111-1307 USA +# ------------------------------------------------------------------- + +=head1 NAME + +SQL::Translator::Parser::DBI::SQLServer - parser for SQL Server through DBD::ODBC + +=head1 SYNOPSIS + +See SQL::Translator::Parser::DBI. + +=head1 DESCRIPTION + +Uses DBI Catalog Methods. + +=cut + +use strict; +use DBI; +use SQL::Translator::Schema; +use Data::Dumper; + +use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; +$VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/; +$DEBUG = 0 unless defined $DEBUG; + +no strict 'refs'; + +# ------------------------------------------------------------------- +sub parse { + my ( $tr, $dbh ) = @_; + + if ($dbh->{FetchHashKeyName} ne 'NAME_uc') { + warn "setting dbh attribute {FetchHashKeyName} to NAME_uc"; + $dbh->{FetchHashKeyName} = 'NAME_uc'; + } + + if ($dbh->{ChopBlanks} != 1) { + warn "setting dbh attribute {ChopBlanks} to 1"; + $dbh->{ChopBlanks} = 1; + } + + my $schema = $tr->schema; + + my ($sth, @tables, $columns); + my $stuff; + + ### Columns + + # it is much quicker to slurp back everything all at once rather + # than make repeated calls + + $sth = $dbh->column_info(undef, undef, undef, undef); + + + foreach my $c (@{$sth->fetchall_arrayref({})}) { + $columns + ->{$c->{TABLE_CAT}} + ->{$c->{TABLE_SCHEM}} + ->{$c->{TABLE_NAME}} + ->{columns} + ->{$c->{COLUMN_NAME}}= $c; + } + + ### Tables and views + + # Get a list of the tables and views. + $sth = $dbh->table_info(); + @tables = @{$sth->fetchall_arrayref({})}; + + my $h = $dbh->selectall_arrayref(q{ +SELECT o.name, colid,c.text + FROM syscomments c + JOIN sysobjects o + ON c.id = o.id + WHERE o.type ='V' +ORDER BY o.name, + c.colid +} +); + + # View text + # I had always thought there was something 'hard' about + # reconstructing text from syscomments .. + # this seems to work fine and is certainly not complicated! + + foreach (@{$h}) { + $stuff->{view}->{$_->[0]}->{text} .= $_->[2]; + } + + #### objects with indexes. + map { + $stuff->{indexes}->{$_->[0]}++ + if defined; + } @{$dbh->selectall_arrayref("SELECT DISTINCT object_name(id) + FROM sysindexes + WHERE indid > 0 and indid < 255 and + name not like '_WA_Sys%'")}; + + ## slurp objects + map { + $stuff->{$_->[1]}->{$_->[0]} = $_; + } @{$dbh->selectall_arrayref("SELECT name,type, id FROM sysobjects")}; + + + ### Procedures + + # This gets legitimate procedures by used the 'supported' API: sp_stored_procedures + map { + my $n = $_->{PROCEDURE_NAME}; + $n =~ s/;\d+$//; # Ignore versions for now + $_->{name} = $n; + $stuff->{procedures}->{$n} = $_; + } values %{$dbh->selectall_hashref("sp_stored_procedures", 'PROCEDURE_NAME')}; + + + # And this blasts in the text of 'legit' stored procedures. Do + # this rather than calling sp_helptext in a loop. + + $h = $dbh->selectall_arrayref(q{ +SELECT o.name, colid,c.text + FROM syscomments c + JOIN sysobjects o + ON c.id = o.id + WHERE o.type ='P' +} +); + + foreach (@{$h}) { + $stuff->{procedures}->{$_->[0]}->{text} .= $_->[2] + if (defined($stuff->{procedures}->{$_->[0]})); + } + + ### Defaults + ### Rules + ### Bind Defaults + ### Bind Rules + + ### Triggers + # Since the 'target' of the trigger is defined in the text, we will + # just create them independently for now rather than associating them + # with a table. + + $h = $dbh->selectall_arrayref(q{ +SELECT o.name, colid,c.text + FROM syscomments c + JOIN sysobjects o + ON c.id = o.id + JOIN sysobjects o1 + ON (o.id = o1.instrig OR o.id = o1.deltrig or o.id = o1.updtrig) + WHERE o.type ='TR' +ORDER BY o.name, + c.colid +} +); + foreach (@{$h}) { + $stuff->{triggers}->{$_->[0]}->{text} .= $_->[2]; + } + + ### References + ### Keys + + ### Types + # Not sure what to do with these? + $stuff->{type_info_all} = $dbh->type_info_all; + + ### Tables + # According to the DBI docs, these can be + + # "TABLE" + # "VIEW" + # "SYSTEM TABLE" + # "GLOBAL TEMPORARY", + # "LOCAL TEMPORARY" + # "ALIAS" + # "SYNONYM" + + foreach my $table_info (@tables) { + next + unless (defined($table_info->{TABLE_TYPE})); + + if ($table_info->{TABLE_TYPE} eq "TABLE") { + my $table = $schema->add_table( + name => +$table_info->{TABLE_NAME}, + type => +$table_info->{TABLE_TYPE}, + ) || die $schema->error; + + # find the associated columns + + my $cols = + $columns->{$table_info->{TABLE_CAT}} + ->{$table_info->{TABLE_SCHEM}} + ->{$table_info->{TABLE_NAME}} + ->{columns}; + + foreach my $c (values %{$cols}) { + my $is_auto_increment = $c->{TYPE_NAME} =~ s#(\(\))? identity##i; + my $f = $table->add_field( + name => $c->{COLUMN_NAME}, + data_type => $c->{TYPE_NAME}, + order => $c->{ORDINAL_POSITION}, + size => $c->{COLUMN_SIZE}, + ) || die $table->error; + $f->is_nullable($c->{NULLABLE} == 1); + $f->is_auto_increment($is_auto_increment); + $c->{COLUMN_DEF} =~ s#\('?(.*?)'?\)#$1#; + $f->default_value($c->{COLUMN_DEF}) if defined $c->{COLUMN_DEF}; + } + + # add in primary key + my $h = $dbh->selectall_hashref("sp_pkeys +$table_info->{TABLE_NAME}", 'COLUMN_NAME'); + if (scalar keys %{$h} >= 1) { + my @c = map { + $_->{COLUMN_NAME} + } sort { + $a->{KEY_SEQ} <=> $b->{KEY_SEQ} + } values %{$h}; + + $table->primary_key(@c) + if (scalar @c); + } + + # add in foreign keys + my $h = $dbh->selectall_hashref("sp_fkeys NULL, +\@fktable_name = '$table_info->{TABLE_NAME}'", 'FK_NAME'); + foreach my $fk ( values %{$h} ) { + my $constraint = $table->add_constraint( name => $fk->{FK_NAME}, + fields => [$fk->{FKCOLUMN_NAME}], + ); + $constraint->type("FOREIGN_KEY"); + $constraint->on_delete( + $fk->{DELETE_RULE} == 0 ? "CASCADE" : + $fk->{DELETE_RULE} == 1 ? "NO ACTION" : "SET_NULL" + ); + $constraint->on_update( + $fk->{UPDATE_RULE} == 0 ? "CASCADE" : + $fk->{UPDATE_RULE} == 1 ? "NO ACTION" : "SET_NULL" + ); + $constraint->reference_table($fk->{PKTABLE_NAME}); + } + + # add in any indexes ... how do we tell if the index has + # already been created as part of a primary key or other + # constraint? + + if (defined($stuff->{indexes}->{$table_info->{TABLE_NAME}})){ + my $h = $dbh->selectall_hashref("sp_helpindex +$table_info->{TABLE_NAME}", 'INDEX_NAME'); + foreach (values %{$h}) { + my $fields = $_->{'INDEX_KEYS'}; + $fields =~ s/\s*//g; + my $i = $table->add_index( + name => +$_->{INDEX_NAME}, + fields => $fields, + ); + if ($_->{'INDEX_DESCRIPTION'} =~ /unique/i) { + $i->type('unique'); + + # we could make this a primary key if there + # isn't already one defined and if there + # aren't any nullable columns in thisindex. + + if (!defined($table->primary_key())) { + $table->primary_key($fields) + unless grep { + $table->get_field($_)->is_nullable() + } split(/,\s*/, $fields); + } + } + } + } + } elsif ($table_info->{TABLE_TYPE} eq 'VIEW') { + next if $table_info->{TABLE_NAME} eq 'sysconstraints' + || $table_info->{TABLE_NAME} eq 'syssegments'; + my $view = $schema->add_view( + name => +$table_info->{TABLE_NAME}, + ); + + + my $cols = + $columns->{$table_info->{TABLE_CAT}} + ->{$table_info->{TABLE_SCHEM}} + ->{$table_info->{TABLE_NAME}} + ->{columns}; + + $view->fields(map { + $_->{COLUMN_NAME} + } sort { + $a->{ORDINAL_POSITION} <=> $b->{ORDINAL_POSITION} + } values %{$cols} + ); + + $view->sql($stuff->{view}->{$table_info->{TABLE_NAME}}->{text}) + if (defined($stuff->{view}->{$table_info->{TABLE_NAME}}->{text})); + } + } + + foreach my $p (values %{$stuff->{procedures}}) { + my $proc = $schema->add_procedure( + name => $p->{name}, + owner => $p->{PROCEDURE_OWNER}, + comments => $p->{REMARKS}, + sql => $p->{text}, + ); + + } + + ### Permissions + ### Groups + ### Users + ### Aliases + ### Logins + return 1; +} + +1; + +# ------------------------------------------------------------------- + +=pod + +=head1 AUTHOR + +Chris Hilton Echris@dctank.comE - Bulk of code from +DBI-Sybase parser, I just tweaked it for SQLServer. Thanks. + +=head1 SEE ALSO + +DBI, DBD::ODBC, SQL::Translator::Schema. + +=cut