lib/SQL/Translator/Producer/PostgreSQL.pm

   1 package SQL::Translator::Producer::PostgreSQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: PostgreSQL.pm,v 1.2 2002-11-22 03:03:40 kycl4rk Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2002 Ken Y. Clark <kclark@cpan.org>,
   7 #                    darren chamberlain <darren@cpan.org>
   8 #
   9 # This program is free software; you can redistribute it and/or
  10 # modify it under the terms of the GNU General Public License as
  11 # published by the Free Software Foundation; version 2.
  12 #
  13 # This program is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 # General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with this program; if not, write to the Free Software
  20 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  21 # 02111-1307  USA
  22 # -------------------------------------------------------------------
  23
  24 use strict;
  25 use vars qw($VERSION $DEBUG);
  26 $VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
  27 $DEBUG = 1 unless defined $DEBUG;
  28
  29 use Data::Dumper;
  30
  31 my %translate  = (
  32     #
  33     # MySQL types
  34     #
  35     bigint     => 'bigint',
  36     double     => 'double precision',
  37     decimal    => 'decimal',
  38     float      => 'double precision',
  39     int        => 'integer',
  40     mediumint  => 'integer',
  41     smallint   => 'smallint',
  42     tinyint    => 'smallint',
  43     char       => 'char',
  44     varchar    => 'varchar',
  45     longtext   => 'text',
  46     mediumtext => 'text',
  47     text       => 'text',
  48     tinytext   => 'text',
  49     tinyblob   => 'bytea',
  50     blob       => 'bytea',
  51     mediumblob => 'bytea',
  52     longblob   => 'bytea',
  53     enum       => 'varchar',
  54     set        => 'varchar',
  55     date       => 'date',
  56     datetime   => 'timestamp',
  57     time       => 'date',
  58     timestamp  => 'timestamp',
  59     year       => 'date',
  60
  61     #
  62     # Oracle types
  63     #
  64 );
  65
  66
  67 sub import {
  68     warn "loading " . __PACKAGE__ . "...\n";
  69 }
  70
  71 sub produce {
  72     my ( $translator, $data ) = @_;
  73     debug("Beginning production\n");
  74     my $create = sprintf "--\n-- Created by %s\n-- Created on %s\n-- \n\n",
  75         __PACKAGE__, scalar localtime;
  76
  77     for my $table ( keys %{ $data } ) {
  78         debug( "Looking at table '$table'\n" );
  79         my $table_data = $data->{$table};
  80         my @fields     = sort {
  81             $table_data->{'fields'}->{$a}->{'order'}
  82             <=>
  83             $table_data->{'fields'}->{$b}->{'order'}
  84         } keys %{ $table_data->{'fields'} };
  85
  86         $create .= "--\n-- Table: $table\n--\n";
  87         $create .= "CREATE TABLE $table (\n";
  88
  89         #
  90         # Fields
  91         #
  92         my @field_statements;
  93         for my $field ( @fields ) {
  94             debug("Looking at field '$field'\n");
  95             my $field_data = $table_data->{'fields'}->{ $field };
  96             my @fdata      = ("", $field);
  97
  98             # data type and size
  99             push @fdata, sprintf "%s%s",
 100                 $field_data->{'data_type'},
 101                 ( defined $field_data->{'size'} )
 102                     ? "($field_data->{'size'})" : '';
 103
 104             # Null?
 105             push @fdata, "NOT NULL" unless $field_data->{'null'};
 106
 107             # Default?  XXX Need better quoting!
 108             my $default = $field_data->{'default'};
 109             if ( defined $default ) {
 110                 push @fdata, "DEFAULT '$default'";
 111 #                if (int $default eq "$default") {
 112 #                    push @fdata, "DEFAULT $default";
 113 #                } else {
 114 #                    push @fdata, "DEFAULT '$default'";
 115 #                }
 116             }
 117
 118             # auto_increment?
 119             push @fdata, "auto_increment" if $field_data->{'is_auto_inc'};
 120
 121             # primary key?
 122             push @fdata, "PRIMARY KEY" if $field_data->{'is_primary_key'};
 123
 124             push @field_statements, join( " ", @fdata );
 125
 126         }
 127         $create .= join( ",\n", @field_statements );
 128
 129         #
 130         # Other keys
 131         #
 132         my @indices = @{ $table_data->{'indices'} || [] };
 133         for ( my $i = 0; $i <= $#indices; $i++ ) {
 134             $create .= ",\n";
 135             my $key = $indices[$i];
 136             my ( $name, $type, $fields ) = @{ $key }{ qw( name type fields ) };
 137             if ( $type eq 'primary_key' ) {
 138                 $create .= " PRIMARY KEY (@{$fields})"
 139             }
 140             else {
 141                 local $" = ", ";
 142                 $create .= " KEY $name (@{$fields})"
 143             }
 144         }
 145
 146         #
 147         # Footer
 148         #
 149         $create .= "\n);\n\n";
 150     }
 151
 152     return $create;
 153 }
 154
 155 use Carp;
 156 sub debug {
 157     if ( $DEBUG ) {
 158         map { carp "[" . __PACKAGE__ . "] $_" } @_;
 159     }
 160 }
 161
 162 1;
 163 __END__
 164
 165 =head1 NAME
 166
 167 SQL::Translator::Producer::PostgreSQL - PostgreSQL-specific producer for SQL::Translator
 168
 169 =head1 AUTHOR
 170
 171 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
 172
 173 =cut