lib/SQL/Translator/Producer/PostgreSQL.pm

   1 package SQL::Translator::Producer::PostgreSQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: PostgreSQL.pm,v 1.1 2002-11-20 04:03:56 kycl4rk Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2002 Ken Y. Clark <kycl4rk@users.sourceforge.net>,
   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.1 $ =~ /(\d+)\.(\d+)/;
  27 $DEBUG = 1 unless defined $DEBUG;
  28
  29 use Data::Dumper;
  30
  31 sub import {
  32     warn "loading " . __PACKAGE__ . "...\n";
  33 }
  34
  35 sub produce {
  36     my ( $translator, $data ) = @_;
  37     debug("Beginning production\n");
  38     my $create = sprintf "--\n-- Created by %s\n-- Created on %s\n-- \n\n",
  39         __PACKAGE__, scalar localtime;
  40
  41     for my $table ( keys %{ $data } ) {
  42         debug( "Looking at table '$table'\n" );
  43         my $table_data = $data->{$table};
  44         my @fields     = sort {
  45             $table_data->{'fields'}->{$a}->{'order'}
  46             <=>
  47             $table_data->{'fields'}->{$b}->{'order'}
  48         } keys %{ $table_data->{'fields'} };
  49
  50         $create .= "--\n-- Table: $table\n--\n";
  51         $create .= "CREATE TABLE $table (\n";
  52
  53         #
  54         # Fields
  55         #
  56         my @field_statements;
  57         for ( my $i = 0; $i <= $#fields; $i++ ) {
  58             my $field = $fields[$i];
  59             debug("Looking at field '$field'\n");
  60             my $field_data = $table_data->{'fields'}->{ $field };
  61             my @fdata      = ("", $field);
  62
  63             # data type and size
  64             push @fdata, sprintf "%s%s",
  65                 $field_data->{'data_type'},
  66                 ( defined $field_data->{'size'} )
  67                     ? "($field_data->{'size'})" : '';
  68
  69             # Null?
  70             push @fdata, "NOT NULL" unless $field_data->{'null'};
  71
  72             # Default?  XXX Need better quoting!
  73             if (my $default = $field_data->{'default'}) {
  74                 push @fdata, "DEFAULT '$default'";
  75 #                if (int $default eq "$default") {
  76 #                    push @fdata, "DEFAULT $default";
  77 #                } else {
  78 #                    push @fdata, "DEFAULT '$default'";
  79 #                }
  80             }
  81
  82             # auto_increment?
  83             push @fdata, "auto_increment" if $field_data->{'is_auto_inc'};
  84
  85             # primary key?
  86             push @fdata, "PRIMARY KEY" if $field_data->{'is_primary_key'};
  87
  88             push @field_statements, join( " ", @fdata );
  89
  90         }
  91         $create .= join( ",\n", @field_statements );
  92
  93         #
  94         # Other keys
  95         #
  96         my @indices = @{ $table_data->{'indices'} };
  97         for ( my $i = 0; $i <= $#indices; $i++ ) {
  98             $create .= ",\n";
  99             my $key = $indices[$i];
 100             my ( $name, $type, $fields ) = @{ $key }{ qw( name type fields ) };
 101             if ( $type eq 'primary_key' ) {
 102                 $create .= " PRIMARY KEY (@{$fields})"
 103             }
 104             else {
 105                 local $" = ", ";
 106                 $create .= " KEY $name (@{$fields})"
 107             }
 108         }
 109
 110         #
 111         # Footer
 112         #
 113         $create .= "\n);\n\n";
 114     }
 115
 116     return $create;
 117 }
 118
 119 use Carp;
 120 sub debug {
 121     if ($DEBUG) {
 122         map { carp "[" . __PACKAGE__ . "] $_" } @_;
 123     }
 124 }
 125
 126 1;
 127 __END__
 128
 129 =head1 NAME
 130
 131 SQL::Translator::Producer::PostgreSQL - PostgreSQL-specific producer for SQL::Translator
 132
 133 =head1 AUTHOR
 134
 135 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
 136
 137 =cut