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

   1 package SQL::Translator::Parser::DBI::PostgreSQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: PostgreSQL.pm,v 1.7 2004-09-15 21:13:43 schiffbruechige 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.7 $ =~ /(\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->table_info();
  70
  71     @tables   = @{$sth->fetchall_arrayref({})};
  72
  73     foreach my $table_info (@tables) {
  74         next
  75             unless (defined($table_info->{TABLE_TYPE}));
  76
  77         if ($table_info->{TABLE_TYPE} eq 'TABLE'&&
  78             $table_info->{TABLE_SCHEM} eq 'public') {
  79             my $table = $schema->add_table(
  80                                            name => $table_info->{TABLE_NAME},
  81                                            type => $table_info->{TABLE_TYPE},
  82                                           ) || die $schema->error;
  83
  84
  85             my $cols = $dbh->column_info(undef,
  86                                          $table_info->{TABLE_SCHEM},
  87                                          $table_info->{TABLE_NAME},
  88                                          "%" )->fetchall_arrayref({});
  89
  90             foreach my $c (@{$cols}) {
  91                 print Dumper($c) if $DEBUG;
  92                 my $f = $table->add_field(
  93                                         name        => $c->{COLUMN_NAME},
  94                                         default_value => $c->{COLUMN_DEF},
  95                                         data_type   => $c->{TYPE_NAME},
  96                                         order       => $c->{ORDINAL_POSITION},
  97                                         size        => $c->{COLUMN_SIZE},
  98                                          ) || die $table->error;
  99
 100
 101                 $f->is_nullable($c->{NULLABLE} == 1);
 102             }
 103         }
 104     }
 105
 106     return 1;
 107 }
 108
 109 1;
 110
 111 # -------------------------------------------------------------------
 112 # Time is a waste of money.
 113 # Oscar Wilde
 114 # -------------------------------------------------------------------
 115
 116 =pod
 117
 118 =head1 AUTHOR
 119
 120 Paul Harrington E<lt>harringp@deshaw.comE<gt>.
 121
 122 =head1 SEE ALSO
 123
 124 SQL::Translator, DBD::Pg.
 125
 126 =cut