From: Ken Youens-Clark Date: Fri, 3 Oct 2003 20:48:38 +0000 (+0000) Subject: Adding Sybase parser for Paul. X-Git-Tag: v0.04~143 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=86ee0658cdecb71d7871b0e5df8e40fdf67b76cf;p=dbsrgits%2FSQL-Translator.git Adding Sybase parser for Paul. --- diff --git a/lib/SQL/Translator/Parser/DBI/Sybase.pm b/lib/SQL/Translator/Parser/DBI/Sybase.pm new file mode 100644 index 0000000..f6a86bf --- /dev/null +++ b/lib/SQL/Translator/Parser/DBI/Sybase.pm @@ -0,0 +1,262 @@ +package SQL::Translator::Parser::DBI::Sybase; + +# $Id: Sybase.pm,v 1.1 2003-10-03 20:48:38 kycl4rk Exp $ + +=head1 NAME + +SQL::Translator::Parser::DBI::Sybase - parser for DBD::Sybase + +=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(); + + + 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,colid2,c.text + FROM syscomments c + JOIN sysobjects o + ON c.id = o.id + WHERE o.type ='V' +ORDER BY o.name, + c.colid, + c.colid2 +} +); + + # 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} .= $_->[3]; + } + + #### objects with indexes. + map { + $stuff->{indexes}->{$_->[0]}++ + if defined; + } @{$dbh->selectall_arrayref("SELECT DISTINCT object_name(id) AS +name + FROM sysindexes + WHERE indid > 0")}; + + + ## slurp objects + map { + $stuff->{$_->[1]}->{$_->[0]} = $_; + } @{$dbh->selectall_arrayref("SELECT name,type, id FROM +sysobjects")}; + + + ### Procedures + ### Defaults + ### Rules + ### Bind Defaults + ### Bind Rules + + ### Triggers + + ### References + ### Keys + + ### Types + + $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} =~ /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_QUALIFIER}} + ->{$table_info->{TABLE_OWNER}} + ->{$table_info->{TABLE_NAME}} + ->{columns}; + + foreach my $c (values %{$cols}) { + 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(1) + if ($c->{NULLABLE} == 1); + } + + # 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 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') { + my $view = $schema->add_view( + name => +$table_info->{TABLE_NAME}, + ); + + my $cols = + $columns->{$table_info->{TABLE_QUALIFIER}} + ->{$table_info->{TABLE_OWNER}} + ->{$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})); + } + } + ### Permissions + ### Groups + ### Users + ### Aliases + ### Logins + return 1; +} + +1; + +=pod + +=head1 AUTHOR + +Paul Harrington Eharringp@deshaw.comE, + +=head1 SEE ALSO + +DBI, DBD::Sybase, SQL::Translator::Schema. + +=cut +