[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / DBI / PostgreSQL.pm

package SQL::Translator::Parser::DBI::PostgreSQL;

# -------------------------------------------------------------------
# Copyright (C) 2002-2009 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

=head1 SYNOPSIS

See SQL::Translator::Parser::DBI.

=head1 DESCRIPTION

Uses DBI to query PostgreSQL system tables to determine schema structure.   

=cut

use strict;
use DBI;
use Data::Dumper;
use SQL::Translator::Schema::Constants;

use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
$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 $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,
              ARRAY(SELECT a.attname
                  FROM pg_attribute a
                  WHERE a.attrelid=i.indrelid AND a.attnum = ANY(i.indkey)
              ) AS attname,
              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;

        $table->comments($$tablehash{'description'}) if $$tablehash{'description'};

        $column_select->execute($table_oid);

        while (my $columnhash = $column_select->fetchrow_hashref ) {

            #data_type seems to not be populated; perhaps there needs to 
            #be a mapping of query output to reserved constants in sqlt?

            my $col = $table->add_field(
                              name        => $$columnhash{'attname'},
                              default_value => $$columnhash{'adsrc'},
                              data_type   => $$columnhash{'typname'},
                              order       => $$columnhash{'attnum'},
                             ) || die $table->error;

            $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'};
        }

        $index_select->execute($table_oid);

        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 $type;
            if      ($$indexhash{'indisprimary'}) {
                $type = UNIQUE; #PRIMARY_KEY;

                #tell sqlt that this is the primary key:
                my $col_name=$column_names[($$indexhash{'indkey'} - 1)];
                $table->get_field($col_name)->{is_primary_key}=1;

            } elsif ($$indexhash{'indisunique'}) {
                $type = UNIQUE;
            } else {
                $type = NORMAL;
            }


            my @column_ids = split /\s+/, $$indexhash{'indkey'};
            my @columns = split /\s+/, $$indexhash{'attname'};

            $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;
}

1;

# -------------------------------------------------------------------
# Time is a waste of money.
# Oscar Wilde
# -------------------------------------------------------------------

=pod

=head1 AUTHOR

Scott Cain E<lt>cain@cshl.eduE<gt>, previous author: 
Paul Harrington E<lt>harringp@deshaw.comE<gt>.

=head1 SEE ALSO

SQL::Translator, DBD::Pg.

=cut
Commit	Line	Data
80ae061a	1	package SQL::Translator::Parser::DBI::PostgreSQL;
80ae061a	2
44659089	3	# -------------------------------------------------------------------
	4	# Copyright (C) 2002-2009 SQLFairy Authors
	5	#
	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.
	9	#
	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.
	14	#
	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
	18	# 02111-1307 USA
	19	# -------------------------------------------------------------------
	20
80ae061a	21	=head1 NAME
	22
	23	SQL::Translator::Parser::DBI::PostgreSQL - parser for DBD::Pg
	24
	25	=head1 SYNOPSIS
	26
	27	See SQL::Translator::Parser::DBI.
	28
	29	=head1 DESCRIPTION
	30
d2522b19	31	Uses DBI to query PostgreSQL system tables to determine schema structure.
80ae061a	32
	33	=cut
	34
	35	use strict;
	36	use DBI;
80ae061a	37	use Data::Dumper;
	38	use SQL::Translator::Schema::Constants;
	39
da06ac74	40	use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
11ad2df9	41	$VERSION = '1.59';
80ae061a	42	$DEBUG = 0 unless defined $DEBUG;
80ae061a	43
cfeaa28f	44	my $actions = {c => 'cascade',
	45	r => 'restrict',
	46	a => 'no action',
	47	n => 'set null',
	48	d => 'set default',
	49	};
	50
80ae061a	51	# -------------------------------------------------------------------
	52	sub parse {
	53	my ( $tr, $dbh ) = @_;
	54
638e82c2	55	my $schema = $tr->schema;
80ae061a	56
d2522b19	57	my $column_select = $dbh->prepare(
a23f9a9d	58	"SELECT a.attname, format_type(t.oid, a.atttypmod) as typname, a.attnum,
fd52d7dd	59	a.atttypmod as length, a.attnotnull, a.atthasdef, ad.adsrc,
	60	d.description
	61	FROM pg_type t, pg_attribute a
	62	LEFT JOIN pg_attrdef ad ON (ad.adrelid = a.attrelid AND a.attnum = ad.adnum)
	63	LEFT JOIN pg_description d ON (a.attrelid=d.objoid AND a.attnum=d.objsubid)
d2522b19	64	WHERE a.attrelid=? AND attnum>0
	65	AND a.atttypid=t.oid
	66	ORDER BY a.attnum"
	67	);
	68
	69	my $index_select = $dbh->prepare(
	70	"SELECT oid, c.relname, i.indkey, i.indnatts, i.indisunique,
c601ca5d	71	ARRAY(SELECT a.attname
	72	FROM pg_attribute a
	73	WHERE a.attrelid=i.indrelid AND a.attnum = ANY(i.indkey)
	74	) AS attname,
d2522b19	75	i.indisprimary, pg_get_indexdef(oid) AS create_string
d2522b19	76	FROM pg_class c,pg_index i
122353c5	77	WHERE c.relnamespace IN (SELECT oid FROM pg_namespace WHERE nspname='public') AND c.relkind='i'
d2522b19	78	AND c.oid=i.indexrelid AND i.indrelid=?"
	79	);
	80
	81	my $table_select = $dbh->prepare(
fd52d7dd	82	"SELECT c.oid, c.relname, d.description
	83	FROM pg_class c
	84	LEFT JOIN pg_description d ON c.oid=d.objoid AND d.objsubid=0
	85	WHERE relnamespace IN
d2522b19	86	(SELECT oid FROM pg_namespace WHERE nspname='public')
	87	AND relkind='r';"
	88	);
cfeaa28f	89
	90	my $fk_select = $dbh->prepare(
	91	q/
	92	SELECT r.conname,
	93	c.relname,
	94	d.relname AS frelname,
	95	r.conkey,
	96	ARRAY(SELECT column_name::varchar
	97	FROM information_schema.columns
	98	WHERE ordinal_position = ANY (r.conkey)
	99	AND table_schema = n.nspname
	100	AND table_name = c.relname ) AS fields,
	101	r.confkey,
	102	ARRAY(SELECT column_name::varchar
	103	FROM information_schema.columns
	104	WHERE ordinal_position = ANY (r.confkey)
	105	AND table_schema = n.nspname
	106	AND table_name = d.relname ) AS reference_fields,
	107	r.confupdtype,
	108	r.confdeltype,
	109	r.confmatchtype
	110
	111	FROM pg_catalog.pg_constraint r
	112
	113	JOIN pg_catalog.pg_class c
	114	ON c.oid = r.conrelid
	115	AND r.contype = 'f'
	116
	117	JOIN pg_catalog.pg_class d
	118	ON d.oid = r.confrelid
	119
	120	JOIN pg_catalog.pg_namespace n
	121	ON n.oid = c.relnamespace
	122
	123	WHERE pg_catalog.pg_table_is_visible(c.oid)
	124	AND n.nspname = ?
	125	AND c.relname = ?
	126	ORDER BY 1;
	127	/) or die "Can't prepare: $@";
	128
d2522b19	129	$table_select->execute();
	130
	131	while ( my $tablehash = $table_select->fetchrow_hashref ) {
	132
	133	my $table_name = $$tablehash{'relname'};
	134	my $table_oid = $$tablehash{'oid'};
d2522b19	135	my $table = $schema->add_table(
	136	name => $table_name,
	137	#what is type? type => $table_info->{TABLE_TYPE},
638e82c2	138	) \|\| die $schema->error;
80ae061a	139
fd52d7dd	140	$table->comments($$tablehash{'description'}) if $$tablehash{'description'};
fd52d7dd	141
d2522b19	142	$column_select->execute($table_oid);
	143
	144	while (my $columnhash = $column_select->fetchrow_hashref ) {
638e82c2	145
31f10179	146	#data_type seems to not be populated; perhaps there needs to
	147	#be a mapping of query output to reserved constants in sqlt?
	148
	149	my $col = $table->add_field(
d2522b19	150	name => $$columnhash{'attname'},
d2522b19	151	default_value => $$columnhash{'adsrc'},
7ed7402c	152	data_type => $$columnhash{'typname'},
d2522b19	153	order => $$columnhash{'attnum'},
d2522b19	154	) \|\| die $table->error;
31f10179	155
a23f9a9d	156	$col->{size} = [$$columnhash{'length'}]
a23f9a9d	157	if $$columnhash{'length'}>0 && $$columnhash{'length'}<=0xFFFF;
7ed7402c	158	$col->{is_nullable} = $$columnhash{'attnotnull'} ? 0 : 1;
fd52d7dd	159	$col->comments($$columnhash{'description'}) if $$columnhash{'description'};
d2522b19	160	}
638e82c2	161
d2522b19	162	$index_select->execute($table_oid);
	163
	164	my @column_names = $table->field_names();
	165	while (my $indexhash = $index_select->fetchrow_hashref ) {
	166	#don't deal with function indexes at the moment
	167	next if ($$indexhash{'indkey'} eq ''
	168	or !defined($$indexhash{'indkey'}) );
	169
	170	my $type;
31f10179	171	if ($$indexhash{'indisprimary'}) {
	172	$type = UNIQUE; #PRIMARY_KEY;
	173
	174	#tell sqlt that this is the primary key:
	175	my $col_name=$column_names[($$indexhash{'indkey'} - 1)];
	176	$table->get_field($col_name)->{is_primary_key}=1;
	177
	178	} elsif ($$indexhash{'indisunique'}) {
cfeaa28f	179	$type = UNIQUE;
d2522b19	180	} else {
	181	$type = NORMAL;
	182	}
638e82c2	183
c601ca5d	184
d2522b19	185	my @column_ids = split /\s+/, $$indexhash{'indkey'};
c601ca5d	186	my @columns = split /\s+/, $$indexhash{'attname'};
d2522b19	187
	188	$table->add_index(
	189	name => $$indexhash{'relname'},
	190	type => $type,
31f10179	191	fields => \@columns,
d2522b19	192	) \|\| die $table->error;
638e82c2	193	}
cfeaa28f	194
	195	$fk_select->execute('public',$table_name) or die "Can't execute: $@";
	196	my $fkeys = $fk_select->fetchall_arrayref({});
1f5b2625	197	$DEBUG and print Dumper $fkeys;
cfeaa28f	198	for my $con (@$fkeys){
	199	my $con_name = $con->{conname};
	200	my $fields = $con->{fields};
	201	my $reference_fields = $con->{reference_fields};
	202	my $reference_table = $con->{frelname};
	203	my $on_upd = $con->{confupdtype};
	204	my $on_del = $con->{confdeltype};
	205	$table->add_constraint(
	206	name => $con_name,
	207	type => 'foreign_key',
	208	fields => $fields,
	209	reference_fields => $reference_fields,
	210	reference_table => $reference_table,
	211	on_delete => $actions->{$on_upd},
	212	on_update => $actions->{$on_del},
	213	);
	214	}
80ae061a	215	}
cfeaa28f	216
80ae061a	217
	218	return 1;
	219	}
	220
	221	1;
	222
	223	# -------------------------------------------------------------------
13b0b70f	224	# Time is a waste of money.
13b0b70f	225	# Oscar Wilde
80ae061a	226	# -------------------------------------------------------------------
	227
	228	=pod
	229
	230	=head1 AUTHOR
	231
d2522b19	232	Scott Cain E<lt>cain@cshl.eduE<gt>, previous author:
13b0b70f	233	Paul Harrington E<lt>harringp@deshaw.comE<gt>.
80ae061a	234
	235	=head1 SEE ALSO
	236
13b0b70f	237	SQL::Translator, DBD::Pg.
80ae061a	238
80ae061a	239	=cut