lib/SQL/Translator/Parser/DBI/PostgreSQL.pm

   1 package SQL::Translator::Parser::DBI::PostgreSQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: PostgreSQL.pm,v 1.6 2004-02-09 22:23:40 kycl4rk Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2002-4 SQLFairy Authors
   7 #
   8 # This program is free software; you can redistribute it and/or
   9 # modify it under the terms of the GNU General Public License as
  10 # published by the Free Software Foundation; version 2.
  11 #
  12 # This program is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  20 # 02111-1307  USA
  21 # -------------------------------------------------------------------
  22
  23 =head1 NAME
  24
  25 SQL::Translator::Parser::DBI::PostgreSQL - parser for DBD::Pg
  26
  27 =head1 SYNOPSIS
  28
  29 See SQL::Translator::Parser::DBI.
  30
  31 =head1 DESCRIPTION
  32
  33 Uses DBI methods to determine schema structure.  DBI, of course,
  34 delegates to DBD::Pg, and versions < 1.31 of DBD::Pg don't return very
  35 useful information.  It is recommended that you upgrade this module.
  36
  37 =cut
  38
  39 use strict;
  40 use DBI;
  41 use Data::Dumper;
  42 use SQL::Translator::Schema::Constants;
  43
  44 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
  45 $VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/;
  46 $DEBUG   = 0 unless defined $DEBUG;
  47
  48 # -------------------------------------------------------------------
  49 sub parse {
  50     my ( $tr, $dbh ) = @_;
  51
  52     my $schema = $tr->schema;
  53
  54     my ($sth, @tables, $columns);
  55     my $stuff;
  56
  57     warn "DBD:Pg $DBD::Pg::VERSION is not likely to produce anything ".
  58         "useful. Upgrade to 1.31 or better if available.\n"
  59         unless ($DBD::Pg::VERSION ge '1.31');
  60
  61     if ($dbh->{FetchHashKeyName} ne 'NAME_uc') {
  62         $dbh->{FetchHashKeyName} = 'NAME_uc';
  63     }
  64
  65     if ($dbh->{ChopBlanks} != 1) {
  66         $dbh->{ChopBlanks} = 1;
  67     }
  68
  69     $sth = $dbh->column_info();
  70     foreach my $c (@{$sth->fetchall_arrayref({})}) {
  71         $columns
  72             ->{$c->{TABLE_SCHEM}}
  73                 ->{$c->{TABLE_NAME}}
  74                     ->{columns}
  75                         ->{$c->{COLUMN_NAME}}= $c;
  76     }
  77
  78     $sth = $dbh->table_info();
  79
  80     @tables   = @{$sth->fetchall_arrayref({})};
  81
  82     foreach my $table_info (@tables) {
  83         next
  84             unless (defined($table_info->{TABLE_TYPE}));
  85
  86         if ($table_info->{TABLE_TYPE} eq 'TABLE'&&
  87             $table_info->{TABLE_SCHEM} eq 'public') {
  88             my $table = $schema->add_table(
  89                                            name => $table_info->{TABLE_NAME},
  90                                            type => $table_info->{TABLE_TYPE},
  91                                           ) || die $schema->error;
  92
  93
  94             my $cols =
  95                 $columns->{$table_info->{TABLE_SCHEM}}
  96                         ->{$table_info->{TABLE_NAME}}
  97                             ->{columns};
  98
  99             foreach my $c (values %{$cols}) {
 100                 my $f = $table->add_field(
 101                                           name        => $c->{COLUMN_NAME},
 102                                           data_type   => $c->{TYPE_NAME},
 103                                           order       => $c->{ORDINAL_POSITION},
 104                                           size        => $c->{COLUMN_SIZE},
 105                                          ) || die $table->error;
 106
 107                 $f->is_nullable(1)
 108                     if ($c->{NULLABLE} == 1);
 109             }
 110         }
 111     }
 112
 113     return 1;
 114 }
 115
 116 1;
 117
 118 # -------------------------------------------------------------------
 119 # Time is a waste of money.
 120 # Oscar Wilde
 121 # -------------------------------------------------------------------
 122
 123 =pod
 124
 125 =head1 AUTHOR
 126
 127 Paul Harrington E<lt>harringp@deshaw.comE<gt>.
 128
 129 =head1 SEE ALSO
 130
 131 SQL::Translator, DBD::Pg.
 132
 133 =cut