1 package SQL::Translator::Parser::DBI::PostgreSQL;
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>.
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.
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.
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
21 # -------------------------------------------------------------------
25 SQL::Translator::Parser::DBI::PostgreSQL - parser for DBD::Pg
29 See SQL::Translator::Parser::DBI.
41 use SQL::Translator::Schema::Constants;
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;
47 # -------------------------------------------------------------------
49 my ( $tr, $dbh ) = @_;
51 my $db_schema = DBIx::DBSchema->new_native( $dbh );
53 # warn "DBIx::DBSchema =\n", Dumper( $,b_schema ), "\n";
55 my $schema = $tr->schema;
57 my @table_names = $db_schema->tables;
59 for my $table_name ( @table_names ) {
60 my $db_table = $db_schema->table( $table_name );
62 my $table = $schema->add_table(
64 ) or die $schema->error;
66 my @col_names = $db_table->columns;
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;
76 my $field = $table->add_field(
78 data_type => $data_type,
80 default_value => $default,
81 is_nullable => $is_nullable,
82 ) or die $table->error;
84 my $pk = $db_table->primary_key;
85 $table->primary_key( $pk ) if $pk;
88 # my $indices = $dbh->selectall_arrayref(
89 # "show index from $table_name",
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'};
108 # my $is_constraint = $key_name eq 'PRIMARY' || $non_unique == 0;
110 # if ( $is_constraint ) {
111 # $constraints{ $key_name }{'order'} = ++$order;
112 # push @{ $constraints{ $key_name }{'fields'} }, $column_name;
114 # if ( $key_name eq 'PRIMARY' ) {
115 # $constraints{ $key_name }{'type'} = PRIMARY_KEY;
117 # elsif ( $non_unique == 0 ) {
118 # $constraints{ $key_name }{'type'} = UNIQUE;
122 # $keys{ $key_name }{'order'} = ++$order;
123 # push @{ $keys{ $key_name }{'fields'} }, $column_name;
128 # sort { $keys{ $a }{'order'} <=> $keys{ $b }{'order'} }
131 # my $key = $keys{ $key_name };
132 # my $index = $table->add_index(
135 # fields => $key->{'fields'},
136 # ) or die $table->error;
139 # for my $constraint_name (
140 # sort { $constraints{ $a }{'order'} <=> $constraints{ $b }{'order'} }
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;
157 # -------------------------------------------------------------------
158 # Where man is not nature is barren.
160 # -------------------------------------------------------------------
166 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
170 perl(1), Parse::RecDescent, SQL::Translator::Schema.