view release on metacpan or  search on metacpan

lib/SQL/Translator/Parser/DBI/PostgreSQL.pm  view on Meta::CPAN

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

=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.

=head1 CONFIGURATION

You can specify the following for L<SQL::Translator/parser_args> :

=head2 deconstruct_enum_types

If set to a true value, the parser will look for column types which are user-defined Enums,
and generate a column definition like:

  {
    data_type => 'enum',
    extra => {
      custom_type_name => 'MyEnumType',
      list => [ 'enum_val_1', 'enum_val_2', ... ],
    }
  }

This makes a proper round-trip with SQL::Translator::Producer::PostgreSQL (which re-creates the
custom enum type if C<< producer_args->{postgres_version} >= 8.003 >>) and can be translated to
other engines.

If the option is false (the default) you would just get

  { data_type => 'MyEnumType' }

with no provided method to translate it to other SQL engines.

=cut

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

our ($DEBUG, @EXPORT_OK);
our $VERSION = '1.66';
$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 $deconstruct_enum_types = $tr->parser_args->{deconstruct_enum_types};

  my $column_select = $dbh->prepare(
    "SELECT a.attname, a.atttypid, t.typtype, format_type(t.oid, a.atttypmod) as typname, a.attnum,
              a.atttypmod as length, a.attnotnull, a.atthasdef, pg_get_expr(ad.adbin, ad.adrelid) as 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,