1 package SQL::Translator::Parser::DBI::PostgreSQL;
3 # -------------------------------------------------------------------
4 # Copyright (C) 2002-2009 SQLFairy Authors
6 # This program is free software; you can redistribute it and/or
7 # modify it under the terms of the GNU General Public License as
8 # published by the Free Software Foundation; version 2.
10 # This program is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 # General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
19 # -------------------------------------------------------------------
23 SQL::Translator::Parser::DBI::PostgreSQL - parser for DBD::Pg
27 See SQL::Translator::Parser::DBI.
31 Uses DBI to query PostgreSQL system tables to determine schema structure.
38 use SQL::Translator::Schema::Constants;
40 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
42 $DEBUG = 0 unless defined $DEBUG;
44 my $actions = {c => 'cascade',
51 # -------------------------------------------------------------------
53 my ( $tr, $dbh ) = @_;
55 my $schema = $tr->schema;
57 my $column_select = $dbh->prepare(
58 "SELECT a.attname, format_type(t.oid, a.atttypmod) as typname, a.attnum,
59 a.atttypmod as length, a.attnotnull, a.atthasdef, d.adsrc
60 FROM pg_type t,pg_attribute a
61 LEFT JOIN pg_attrdef d ON (d.adrelid = a.attrelid AND a.attnum = d.adnum)
62 WHERE a.attrelid=? AND attnum>0
67 my $index_select = $dbh->prepare(
68 "SELECT oid, c.relname, i.indkey, i.indnatts, i.indisunique,
69 i.indisprimary, pg_get_indexdef(oid) AS create_string
70 FROM pg_class c,pg_index i
71 WHERE c.relnamespace IN (SELECT oid FROM pg_namespace WHERE nspname='public') AND c.relkind='i'
72 AND c.oid=i.indexrelid AND i.indrelid=?"
75 my $table_select = $dbh->prepare(
76 "SELECT oid,relname FROM pg_class WHERE relnamespace IN
77 (SELECT oid FROM pg_namespace WHERE nspname='public')
81 my $fk_select = $dbh->prepare(
85 d.relname AS frelname,
87 ARRAY(SELECT column_name::varchar
88 FROM information_schema.columns
89 WHERE ordinal_position = ANY (r.conkey)
90 AND table_schema = n.nspname
91 AND table_name = c.relname ) AS fields,
93 ARRAY(SELECT column_name::varchar
94 FROM information_schema.columns
95 WHERE ordinal_position = ANY (r.confkey)
96 AND table_schema = n.nspname
97 AND table_name = d.relname ) AS reference_fields,
102 FROM pg_catalog.pg_constraint r
104 JOIN pg_catalog.pg_class c
105 ON c.oid = r.conrelid
108 JOIN pg_catalog.pg_class d
109 ON d.oid = r.confrelid
111 JOIN pg_catalog.pg_namespace n
112 ON n.oid = c.relnamespace
114 WHERE pg_catalog.pg_table_is_visible(c.oid)
118 /) or die "Can't prepare: $@";
120 $table_select->execute();
122 while ( my $tablehash = $table_select->fetchrow_hashref ) {
124 my $table_name = $$tablehash{'relname'};
125 my $table_oid = $$tablehash{'oid'};
127 my $table = $schema->add_table(
129 #what is type? type => $table_info->{TABLE_TYPE},
130 ) || die $schema->error;
132 $column_select->execute($table_oid);
134 while (my $columnhash = $column_select->fetchrow_hashref ) {
136 #data_type seems to not be populated; perhaps there needs to
137 #be a mapping of query output to reserved constants in sqlt?
139 my $col = $table->add_field(
140 name => $$columnhash{'attname'},
141 default_value => $$columnhash{'adsrc'},
142 data_type => $$columnhash{'typname'},
143 order => $$columnhash{'attnum'},
144 ) || die $table->error;
146 $col->{size} = [$$columnhash{'length'}]
147 if $$columnhash{'length'}>0 && $$columnhash{'length'}<=0xFFFF;
148 $col->{is_nullable} = $$columnhash{'attnotnull'} ? 0 : 1;
151 $index_select->execute($table_oid);
153 my @column_names = $table->field_names();
154 while (my $indexhash = $index_select->fetchrow_hashref ) {
155 #don't deal with function indexes at the moment
156 next if ($$indexhash{'indkey'} eq ''
157 or !defined($$indexhash{'indkey'}) );
160 if ($$indexhash{'indisprimary'}) {
161 $type = UNIQUE; #PRIMARY_KEY;
163 #tell sqlt that this is the primary key:
164 my $col_name=$column_names[($$indexhash{'indkey'} - 1)];
165 $table->get_field($col_name)->{is_primary_key}=1;
167 } elsif ($$indexhash{'indisunique'}) {
173 my @column_ids = split /\s+/, $$indexhash{'indkey'};
175 foreach my $col (@column_ids) {
176 push @columns, $column_names[($col - 1)];
180 name => $$indexhash{'relname'},
183 ) || die $table->error;
186 $fk_select->execute('public',$table_name) or die "Can't execute: $@";
187 my $fkeys = $fk_select->fetchall_arrayref({});
188 $DEBUG and print Dumper $fkeys;
189 for my $con (@$fkeys){
190 my $con_name = $con->{conname};
191 my $fields = $con->{fields};
192 my $reference_fields = $con->{reference_fields};
193 my $reference_table = $con->{frelname};
194 my $on_upd = $con->{confupdtype};
195 my $on_del = $con->{confdeltype};
196 $table->add_constraint(
198 type => 'foreign_key',
200 reference_fields => $reference_fields,
201 reference_table => $reference_table,
202 on_delete => $actions->{$on_upd},
203 on_update => $actions->{$on_del},
214 # -------------------------------------------------------------------
215 # Time is a waste of money.
217 # -------------------------------------------------------------------
223 Scott Cain E<lt>cain@cshl.eduE<gt>, previous author:
224 Paul Harrington E<lt>harringp@deshaw.comE<gt>.
228 SQL::Translator, DBD::Pg.