X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FParser%2FDBI%2FPostgreSQL.pm;h=28017a6b958308493d6efacc3f3bc8a45570df72;hb=db195df8af1efc7fb983ec6041fcb064dada7124;hp=ae21eda22dd5668572064e7989f6f6f7e18a1f4e;hpb=900758666f4b53e9a670d84260d28b16f834f69d;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Parser/DBI/PostgreSQL.pm b/lib/SQL/Translator/Parser/DBI/PostgreSQL.pm index ae21eda..28017a6 100644 --- a/lib/SQL/Translator/Parser/DBI/PostgreSQL.pm +++ b/lib/SQL/Translator/Parser/DBI/PostgreSQL.pm @@ -1,25 +1,5 @@ package SQL::Translator::Parser::DBI::PostgreSQL; -# ------------------------------------------------------------------- -# $Id: PostgreSQL.pm,v 1.6 2004-02-09 22:23:40 kycl4rk 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::PostgreSQL - parser for DBD::Pg @@ -30,86 +10,189 @@ See SQL::Translator::Parser::DBI. =head1 DESCRIPTION -Uses DBI methods to determine schema structure. DBI, of course, -delegates to DBD::Pg, and versions < 1.31 of DBD::Pg don't return very -useful information. It is recommended that you upgrade this module. +Uses DBI to query PostgreSQL system tables to determine schema structure. =cut use strict; +use warnings; use DBI; use Data::Dumper; use SQL::Translator::Schema::Constants; -use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/; +our ( $DEBUG, @EXPORT_OK ); +our $VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; -# ------------------------------------------------------------------- +my $actions = {c => 'cascade', + r => 'restrict', + a => 'no action', + n => 'set null', + d => 'set default', + }; + sub parse { my ( $tr, $dbh ) = @_; my $schema = $tr->schema; - my ($sth, @tables, $columns); - my $stuff; + my $column_select = $dbh->prepare( + "SELECT a.attname, format_type(t.oid, a.atttypmod) as typname, a.attnum, + a.atttypmod as length, a.attnotnull, a.atthasdef, ad.adsrc, + d.description + FROM pg_type t, pg_attribute a + LEFT JOIN pg_attrdef ad ON (ad.adrelid = a.attrelid AND a.attnum = ad.adnum) + LEFT JOIN pg_description d ON (a.attrelid=d.objoid AND a.attnum=d.objsubid) + WHERE a.attrelid=? AND attnum>0 + AND a.atttypid=t.oid + ORDER BY a.attnum" + ); + + my $index_select = $dbh->prepare( + "SELECT oid, c.relname, i.indkey, i.indnatts, i.indisunique, + i.indisprimary, pg_get_indexdef(oid) AS create_string + FROM pg_class c,pg_index i + WHERE c.relnamespace IN (SELECT oid FROM pg_namespace WHERE nspname='public') AND c.relkind='i' + AND c.oid=i.indexrelid AND i.indrelid=?" + ); + + my $table_select = $dbh->prepare( + "SELECT c.oid, c.relname, d.description + FROM pg_class c + LEFT JOIN pg_description d ON c.oid=d.objoid AND d.objsubid=0 + WHERE relnamespace IN + (SELECT oid FROM pg_namespace WHERE nspname='public') + AND relkind='r';" + ); + + my $fk_select = $dbh->prepare( + q/ +SELECT r.conname, + c.relname, + d.relname AS frelname, + r.conkey, + ARRAY(SELECT column_name::varchar + FROM information_schema.columns + WHERE ordinal_position = ANY (r.conkey) + AND table_schema = n.nspname + AND table_name = c.relname ) AS fields, + r.confkey, + ARRAY(SELECT column_name::varchar + FROM information_schema.columns + WHERE ordinal_position = ANY (r.confkey) + AND table_schema = n.nspname + AND table_name = d.relname ) AS reference_fields, + r.confupdtype, + r.confdeltype, + r.confmatchtype + +FROM pg_catalog.pg_constraint r + +JOIN pg_catalog.pg_class c + ON c.oid = r.conrelid + AND r.contype = 'f' + +JOIN pg_catalog.pg_class d + ON d.oid = r.confrelid + +JOIN pg_catalog.pg_namespace n + ON n.oid = c.relnamespace + +WHERE pg_catalog.pg_table_is_visible(c.oid) + AND n.nspname = ? + AND c.relname = ? +ORDER BY 1; + /) or die "Can't prepare: $@"; + + $table_select->execute(); + + while ( my $tablehash = $table_select->fetchrow_hashref ) { + + my $table_name = $$tablehash{'relname'}; + my $table_oid = $$tablehash{'oid'}; + my $table = $schema->add_table( + name => $table_name, + #what is type? type => $table_info->{TABLE_TYPE}, + ) || die $schema->error; - warn "DBD:Pg $DBD::Pg::VERSION is not likely to produce anything ". - "useful. Upgrade to 1.31 or better if available.\n" - unless ($DBD::Pg::VERSION ge '1.31'); + $table->comments($$tablehash{'description'}) if $$tablehash{'description'}; - if ($dbh->{FetchHashKeyName} ne 'NAME_uc') { - $dbh->{FetchHashKeyName} = 'NAME_uc'; - } + $column_select->execute($table_oid); - if ($dbh->{ChopBlanks} != 1) { - $dbh->{ChopBlanks} = 1; - } + while (my $columnhash = $column_select->fetchrow_hashref ) { - $sth = $dbh->column_info(); - foreach my $c (@{$sth->fetchall_arrayref({})}) { - $columns - ->{$c->{TABLE_SCHEM}} - ->{$c->{TABLE_NAME}} - ->{columns} - ->{$c->{COLUMN_NAME}}= $c; - } + #data_type seems to not be populated; perhaps there needs to + #be a mapping of query output to reserved constants in sqlt? - $sth = $dbh->table_info(); + my $col = $table->add_field( + name => $$columnhash{'attname'}, + default_value => $$columnhash{'adsrc'}, + data_type => $$columnhash{'typname'}, + order => $$columnhash{'attnum'}, + ) || die $table->error; - @tables = @{$sth->fetchall_arrayref({})}; + $col->{size} = [$$columnhash{'length'}] + if $$columnhash{'length'}>0 && $$columnhash{'length'}<=0xFFFF; + $col->{is_nullable} = $$columnhash{'attnotnull'} ? 0 : 1; + $col->comments($$columnhash{'description'}) if $$columnhash{'description'}; + } - foreach my $table_info (@tables) { - next - unless (defined($table_info->{TABLE_TYPE})); + $index_select->execute($table_oid); - if ($table_info->{TABLE_TYPE} eq 'TABLE'&& - $table_info->{TABLE_SCHEM} eq 'public') { - my $table = $schema->add_table( - name => $table_info->{TABLE_NAME}, - type => $table_info->{TABLE_TYPE}, - ) || die $schema->error; + my @column_names = $table->field_names(); + while (my $indexhash = $index_select->fetchrow_hashref ) { + #don't deal with function indexes at the moment + next if ($$indexhash{'indkey'} eq '' + or !defined($$indexhash{'indkey'}) ); + my @columns = map $column_names[$_ - 1], split /\s+/, $$indexhash{'indkey'}; - my $cols = - $columns->{$table_info->{TABLE_SCHEM}} - ->{$table_info->{TABLE_NAME}} - ->{columns}; + my $type; + if ($$indexhash{'indisprimary'}) { + $type = UNIQUE; #PRIMARY_KEY; - 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; + #tell sqlt that this is the primary key: + for my $column (@columns) { + $table->get_field($column)->{is_primary_key}=1; + } - $f->is_nullable(1) - if ($c->{NULLABLE} == 1); + } elsif ($$indexhash{'indisunique'}) { + $type = UNIQUE; + } else { + $type = NORMAL; } + + + $table->add_index( + name => $$indexhash{'relname'}, + type => $type, + fields => \@columns, + ) || die $table->error; + } + + $fk_select->execute('public',$table_name) or die "Can't execute: $@"; + my $fkeys = $fk_select->fetchall_arrayref({}); + $DEBUG and print Dumper $fkeys; + for my $con (@$fkeys){ + my $con_name = $con->{conname}; + my $fields = $con->{fields}; + my $reference_fields = $con->{reference_fields}; + my $reference_table = $con->{frelname}; + my $on_upd = $con->{confupdtype}; + my $on_del = $con->{confdeltype}; + $table->add_constraint( + name => $con_name, + type => 'foreign_key', + fields => $fields, + reference_fields => $reference_fields, + reference_table => $reference_table, + on_delete => $actions->{$on_upd}, + on_update => $actions->{$on_del}, + ); } } + return 1; } @@ -124,6 +207,7 @@ sub parse { =head1 AUTHOR +Scott Cain Ecain@cshl.eduE, previous author: Paul Harrington Eharringp@deshaw.comE. =head1 SEE ALSO