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

   1 package SQL::Translator::Parser::DBI::PostgreSQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: PostgreSQL.pm,v 1.2 2003-10-13 19:51:31 phrrngtn Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>.
   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 DBIx::DBSchema.
  34
  35 =cut
  36
  37 use strict;
  38 use DBI;
  39 use DBD::Pg 1.31;
  40 use Data::Dumper;
  41 use SQL::Translator::Schema::Constants;
  42
  43 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
  44 $VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
  45 $DEBUG   = 0 unless defined $DEBUG;
  46
  47 # -------------------------------------------------------------------
  48 sub parse {
  49     my ( $tr, $dbh ) = @_;
  50
  51     my $schema = $tr->schema;
  52
  53     my ($sth, @tables, $columns);
  54     my $stuff;
  55
  56
  57     if ($dbh->{FetchHashKeyName} ne 'NAME_uc') {
  58 #        warn "setting dbh attribute {FetchHashKeyName} to NAME_uc";
  59         $dbh->{FetchHashKeyName} = 'NAME_uc';
  60     }
  61
  62     if ($dbh->{ChopBlanks} != 1) {
  63 #        warn "setting dbh attribute {ChopBlanks} to 1";
  64         $dbh->{ChopBlanks} = 1;
  65     }
  66
  67     $sth = $dbh->column_info();
  68     foreach my $c (@{$sth->fetchall_arrayref({})}) {
  69         $columns
  70             ->{$c->{TABLE_SCHEM}}
  71                 ->{$c->{TABLE_NAME}}
  72                     ->{columns}
  73                         ->{$c->{COLUMN_NAME}}= $c;
  74     }
  75
  76     $sth = $dbh->table_info();
  77
  78     @tables   = @{$sth->fetchall_arrayref({})};
  79
  80     foreach my $table_info (@tables) {
  81         next
  82             unless (defined($table_info->{TABLE_TYPE}));
  83
  84         if ($table_info->{TABLE_TYPE} eq 'TABLE'&&
  85             $table_info->{TABLE_SCHEM} eq 'public') {
  86             my $table = $schema->add_table(
  87                                            name => $table_info->{TABLE_NAME},
  88                                            type => $table_info->{TABLE_TYPE},
  89                                           ) || die $schema->error;
  90
  91
  92             my $cols =
  93                 $columns->{$table_info->{TABLE_SCHEM}}
  94                         ->{$table_info->{TABLE_NAME}}
  95                             ->{columns};
  96
  97             foreach my $c (values %{$cols}) {
  98                 my $f = $table->add_field(
  99                                           name        => $c->{COLUMN_NAME},
 100                                           data_type   => $c->{TYPE_NAME},
 101                                           order       => $c->{ORDINAL_POSITION},
 102                                           size        => $c->{COLUMN_SIZE},
 103                                          ) || die $table->error;
 104
 105                 $f->is_nullable(1)
 106                     if ($c->{NULLABLE} == 1);
 107             }
 108         }
 109     }
 110
 111     return 1;
 112 }
 113
 114 1;
 115
 116 # -------------------------------------------------------------------
 117 # Where man is not nature is barren.
 118 # William Blake
 119 # -------------------------------------------------------------------
 120
 121 =pod
 122
 123 =head1 AUTHOR
 124
 125 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 126
 127 =head1 SEE ALSO
 128
 129 perl(1), Parse::RecDescent, SQL::Translator::Schema.
 130
 131 =cut