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

   1 package SQL::Translator::Parser::DBI::PostgreSQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: PostgreSQL.pm,v 1.1 2003-10-10 15:24:04 kycl4rk 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 DBIx::DBSchema;
  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.1 $ =~ /(\d+)\.(\d+)/;
  45 $DEBUG   = 0 unless defined $DEBUG;
  46
  47 # -------------------------------------------------------------------
  48 sub parse {
  49     my ( $tr, $dbh ) = @_;
  50
  51     my $db_schema = DBIx::DBSchema->new_native( $dbh );
  52
  53 #    warn "DBIx::DBSchema =\n", Dumper( $,b_schema ), "\n";
  54
  55     my $schema = $tr->schema;
  56
  57     my @table_names = $db_schema->tables;
  58
  59     for my $table_name ( @table_names ) {
  60         my $db_table = $db_schema->table( $table_name );
  61
  62         my $table =  $schema->add_table(
  63             name  => $table_name,
  64         ) or die $schema->error;
  65
  66         my @col_names = $db_table->columns;
  67
  68         for my $col_name ( @col_names ) {
  69             my $db_col      = $db_table->column( $col_name );
  70             my $fname       = $db_col->name or next;
  71             my $data_type   = $db_col->type or next;
  72             my $size        = $db_col->length;
  73             my $is_nullable = $db_col->null eq 'NULL' ? 1 : 0;
  74             my $default     = $db_col->default;
  75
  76             my $field             =  $table->add_field(
  77                 name              => $fname,
  78                 data_type         => $data_type,
  79                 size              => $size,
  80                 default_value     => $default,
  81                 is_nullable       => $is_nullable,
  82             ) or die $table->error;
  83
  84             my $pk = $db_table->primary_key;
  85             $table->primary_key( $pk ) if $pk;
  86         }
  87
  88 #        my $indices = $dbh->selectall_arrayref(
  89 #            "show index from $table_name",
  90 #            { Columns => {} },
  91 #        );
  92 #
  93 #        my ( %keys, %constraints, $order );
  94 #        for my $index ( @$indices ) {
  95 #            my $table        = $index->{'table'};
  96 #            my $non_unique   = $index->{'non_unique'};
  97 #            my $key_name     = $index->{'key_name'} || '';
  98 #            my $seq_in_index = $index->{'seq_in_index'};
  99 #            my $column_name  = $index->{'column_name'};
 100 #            my $collation    = $index->{'collation'};
 101 #            my $cardinality  = $index->{'cardinality'};
 102 #            my $sub_part     = $index->{'sub_part'};
 103 #            my $packed       = $index->{'packed'};
 104 #            my $null         = $index->{'null'};
 105 #            my $index_type   = $index->{'index_type'};
 106 #            my $comment      = $index->{'comment'};
 107 #
 108 #            my $is_constraint = $key_name eq 'PRIMARY' || $non_unique == 0;
 109 #
 110 #            if ( $is_constraint ) {
 111 #                $constraints{ $key_name }{'order'} = ++$order;
 112 #                push @{ $constraints{ $key_name }{'fields'} }, $column_name;
 113 #
 114 #                if ( $key_name eq 'PRIMARY' ) {
 115 #                    $constraints{ $key_name }{'type'} = PRIMARY_KEY;
 116 #                }
 117 #                elsif ( $non_unique == 0 ) {
 118 #                    $constraints{ $key_name }{'type'} = UNIQUE;
 119 #                }
 120 #            }
 121 #            else {
 122 #                $keys{ $key_name }{'order'} = ++$order;
 123 #                push @{ $keys{ $key_name }{'fields'} }, $column_name;
 124 #            }
 125 #        }
 126 #
 127 #        for my $key_name (
 128 #            sort { $keys{ $a }{'order'} <=> $keys{ $b }{'order'} }
 129 #            keys %keys
 130 #        ) {
 131 #            my $key    = $keys{ $key_name };
 132 #            my $index  =  $table->add_index(
 133 #                name   => $key_name,
 134 #                type   => NORMAL,
 135 #                fields => $key->{'fields'},
 136 #            ) or die $table->error;
 137 #        }
 138 #
 139 #        for my $constraint_name (
 140 #            sort { $constraints{ $a }{'order'} <=> $constraints{ $b }{'order'} }
 141 #            keys %constraints
 142 #        ) {
 143 #            my $def        = $constraints{ $constraint_name };
 144 #            my $constraint =  $table->add_constraint(
 145 #                name       => $constraint_name,
 146 #                type       => $def->{'type'},
 147 #                fields     => $def->{'fields'},
 148 #            ) or die $table->error;
 149 #        }
 150     }
 151
 152     return 1;
 153 }
 154
 155 1;
 156
 157 # -------------------------------------------------------------------
 158 # Where man is not nature is barren.
 159 # William Blake
 160 # -------------------------------------------------------------------
 161
 162 =pod
 163
 164 =head1 AUTHOR
 165
 166 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 167
 168 =head1 SEE ALSO
 169
 170 perl(1), Parse::RecDescent, SQL::Translator::Schema.
 171
 172 =cut