[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / PostgreSQL.pm

package SQL::Translator::Producer::PostgreSQL;

# -------------------------------------------------------------------
# $Id: PostgreSQL.pm,v 1.28 2006-11-20 23:56:14 schiffbruechige Exp $
# -------------------------------------------------------------------
# Copyright (C) 2002-4 SQLFairy Authors
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; version 2.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307  USA
# -------------------------------------------------------------------

=head1 NAME

SQL::Translator::Producer::PostgreSQL - PostgreSQL producer for SQL::Translator

=head1 SYNOPSIS

  my $t = SQL::Translator->new( parser => '...', producer => 'PostgreSQL' );
  $t->translate;

=head1 DESCRIPTION

Creates a DDL suitable for PostgreSQL.  Very heavily based on the Oracle
producer.

=cut

use strict;
use warnings;
use vars qw[ $DEBUG $WARN $VERSION ];
$VERSION = sprintf "%d.%02d", q$Revision: 1.28 $ =~ /(\d+)\.(\d+)/;
$DEBUG = 1 unless defined $DEBUG;

use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(header_comment);
use Data::Dumper;

my %translate;
my $max_id_length;

BEGIN {

 %translate  = (
    #
    # MySQL types
    #
    bigint     => 'bigint',
    double     => 'numeric',
    decimal    => 'numeric',
    float      => 'numeric',
    int        => 'integer',
    mediumint  => 'integer',
    smallint   => 'smallint',
    tinyint    => 'smallint',
    char       => 'character',
    varchar    => 'character varying',
    longtext   => 'text',
    mediumtext => 'text',
    text       => 'text',
    tinytext   => 'text',
    tinyblob   => 'bytea',
    blob       => 'bytea',
    mediumblob => 'bytea',
    longblob   => 'bytea',
    enum       => 'character varying',
    set        => 'character varying',
    date       => 'date',
    datetime   => 'timestamp',
    time       => 'date',
    timestamp  => 'timestamp',
    year       => 'date',

    #
    # Oracle types
    #
    number     => 'integer',
    char       => 'character',
    varchar2   => 'character varying',
    long       => 'text',
    CLOB       => 'bytea',
    date       => 'date',

    #
    # Sybase types
    #
    int        => 'integer',
    money      => 'money',
    varchar    => 'character varying',
    datetime   => 'timestamp',
    text       => 'text',
    real       => 'numeric',
    comment    => 'text',
    bit        => 'bit',
    tinyint    => 'smallint',
    float      => 'numeric',
);

 $max_id_length = 62;
}
my %reserved = map { $_, 1 } qw[
    ALL ANALYSE ANALYZE AND ANY AS ASC 
    BETWEEN BINARY BOTH
    CASE CAST CHECK COLLATE COLUMN CONSTRAINT CROSS
    CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER 
    DEFAULT DEFERRABLE DESC DISTINCT DO
    ELSE END EXCEPT
    FALSE FOR FOREIGN FREEZE FROM FULL 
    GROUP HAVING 
    ILIKE IN INITIALLY INNER INTERSECT INTO IS ISNULL 
    JOIN LEADING LEFT LIKE LIMIT 
    NATURAL NEW NOT NOTNULL NULL
    OFF OFFSET OLD ON ONLY OR ORDER OUTER OVERLAPS
    PRIMARY PUBLIC REFERENCES RIGHT 
    SELECT SESSION_USER SOME TABLE THEN TO TRAILING TRUE 
    UNION UNIQUE USER USING VERBOSE WHEN WHERE
];

# my $max_id_length    = 62;
my %used_identifiers = ();
my %global_names;
my %unreserve;
my %truncated;

=pod

=head1 PostgreSQL Create Table Syntax

  CREATE [ [ LOCAL ] { TEMPORARY | TEMP } ] TABLE table_name (
      { column_name data_type [ DEFAULT default_expr ] [ column_constraint [, ... ] ]
      | table_constraint }  [, ... ]
  )
  [ INHERITS ( parent_table [, ... ] ) ]
  [ WITH OIDS | WITHOUT OIDS ]

where column_constraint is:

  [ CONSTRAINT constraint_name ]
  { NOT NULL | NULL | UNIQUE | PRIMARY KEY |
    CHECK (expression) |
    REFERENCES reftable [ ( refcolumn ) ] [ MATCH FULL | MATCH PARTIAL ]
      [ ON DELETE action ] [ ON UPDATE action ] }
  [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]

and table_constraint is:

  [ CONSTRAINT constraint_name ]
  { UNIQUE ( column_name [, ... ] ) |
    PRIMARY KEY ( column_name [, ... ] ) |
    CHECK ( expression ) |
    FOREIGN KEY ( column_name [, ... ] ) REFERENCES reftable [ ( refcolumn [, ... ] ) ]
      [ MATCH FULL | MATCH PARTIAL ] [ ON DELETE action ] [ ON UPDATE action ] }
  [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]

=head1 Create Index Syntax

  CREATE [ UNIQUE ] INDEX index_name ON table
      [ USING acc_method ] ( column [ ops_name ] [, ...] )
      [ WHERE predicate ]
  CREATE [ UNIQUE ] INDEX index_name ON table
      [ USING acc_method ] ( func_name( column [, ... ]) [ ops_name ] )
      [ WHERE predicate ]

=cut

# -------------------------------------------------------------------
sub produce {
    my $translator     = shift;
    $DEBUG             = $translator->debug;
    $WARN              = $translator->show_warnings;
    my $no_comments    = $translator->no_comments;
    my $add_drop_table = $translator->add_drop_table;
    my $schema         = $translator->schema;

    my $qt = '';
    $qt = '"' if ($translator->quote_table_names);
    my $qf = '';
    $qf = '"' if ($translator->quote_field_names);
    
    my $output;
    $output .= header_comment unless ($no_comments);
#    my %used_index_names;

    my (@table_defs, @fks);
    for my $table ( $schema->get_tables ) {

        my ($table_def, $fks) = create_table($table, 
                                             { quote_table_names => $qt,
                                               quote_field_names => $qf,
                                               no_comments => $no_comments,
                                               add_drop_table => $add_drop_table,});
        push @table_defs, $table_def;
        push @fks, @$fks;

    }

    $output = join("\n\n", @table_defs);
    if ( @fks ) {
        $output .= "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
        $output .= join( "\n\n", @fks ) . "\n";
    }

    if ( $WARN ) {
        if ( %truncated ) {
            warn "Truncated " . keys( %truncated ) . " names:\n";
            warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
        }

        if ( %unreserve ) {
            warn "Encounted " . keys( %unreserve ) .
                " unsafe names in schema (reserved or invalid):\n";
            warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
        }
    }

    return $output;
}

# -------------------------------------------------------------------
sub mk_name {
    my $basename      = shift || ''; 
    my $type          = shift || ''; 
    my $scope         = shift || ''; 
    my $critical      = shift || '';
    my $basename_orig = $basename;
#    my $max_id_length = 62;
    my $max_name      = $type 
                        ? $max_id_length - (length($type) + 1) 
                        : $max_id_length;
    $basename         = substr( $basename, 0, $max_name ) 
                        if length( $basename ) > $max_name;
    my $name          = $type ? "${type}_$basename" : $basename;

    if ( $basename ne $basename_orig and $critical ) {
        my $show_type = $type ? "+'$type'" : "";
        warn "Truncating '$basename_orig'$show_type to $max_id_length ",
            "character limit to make '$name'\n" if $WARN;
        $truncated{ $basename_orig } = $name;
    }

    $scope ||= \%global_names;
    if ( my $prev = $scope->{ $name } ) {
        my $name_orig = $name;
        $name        .= sprintf( "%02d", ++$prev );
        substr($name, $max_id_length - 3) = "00" 
            if length( $name ) > $max_id_length;

        warn "The name '$name_orig' has been changed to ",
             "'$name' to make it unique.\n" if $WARN;

        $scope->{ $name_orig }++;
    }

    $scope->{ $name }++;
    return $name;
}

# -------------------------------------------------------------------
sub unreserve {
    my $name            = shift || '';
    my $schema_obj_name = shift || '';

    my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';

    # also trap fields that don't begin with a letter
    return $name if (!$reserved{ uc $name }) && $name =~ /^[a-z]/i; 

    if ( $schema_obj_name ) {
        ++$unreserve{"$schema_obj_name.$name"};
    }
    else {
        ++$unreserve{"$name (table name)"};
    }

    my $unreserve = sprintf '%s_', $name;
    return $unreserve.$suffix;
}

# -------------------------------------------------------------------
sub next_unused_name {
    my $name       = shift || '';
    my $used_names = shift || '';

    my %used_names = %$used_names;

    if ( !defined($used_names{$name}) ) {
        $used_names{$name} = $name;
        return $name;
    }
    
    my $i = 2;
    while ( defined($used_names{$name . $i}) ) {
        ++$i;
    }
    $name .= $i;
    $used_names{$name} = $name;
    return $name;
}

sub create_table 
{
    my ($table, $options) = @_;

    my $qt = $options->{quote_table_names} || '';
    my $qf = $options->{quote_field_names} || '';
    my $no_comments = $options->{no_comments} || 0;
    my $add_drop_table = $options->{add_drop_table} || 0;

    my $table_name    = $table->name or next;
    $table_name       = mk_name( $table_name, '', undef, 1 );
    my $table_name_ur = $qt ? $table_name : unreserve($table_name);
    $table->name($table_name_ur);

# print STDERR "$table_name table_name\n";
    my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @fks );

    push @comments, "--\n-- Table: $table_name_ur\n--" unless $no_comments;

    if ( $table->comments and !$no_comments ){
        my $c = "-- Comments: \n-- ";
        $c .= join "\n-- ",  $table->comments;
        $c .= "\n--";
        push @comments, $c;
    }

    #
    # Fields
    #
    my %field_name_scope;
    for my $field ( $table->get_fields ) {
        push @field_defs, create_field($field, { quote_table_names => $qt,
                                                 quote_field_names => $qf,
                                                 table_name => $table_name_ur,
                                                 constraint_defs => \@constraint_defs,});
    }

    #
    # Index Declarations
    #
    my @index_defs = ();
 #   my $idx_name_default;
    for my $index ( $table->get_indices ) {
        my ($idef, $constraints) = create_index($index,
                                              { 
                                                  quote_field_names => $qf,
                                                  quote_table_names => $qt,
                                                  table_name => $table_name,
                                              });
        push @index_defs, $idef;
        push @constraint_defs, @$constraints;
    }

    #
    # Table constraints
    #
    my $c_name_default;
    for my $c ( $table->get_constraints ) {
        my ($cdefs, $fks) = create_constraint($c, 
                                              { 
                                                  quote_field_names => $qf,
                                                  quote_table_names => $qt,
                                                  table_name => $table_name,
                                              });
        push @constraint_defs, @$cdefs;
        push @fks, @$fks;
    }

    my $create_statement;
    $create_statement = join("\n", @comments);
    $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n] 
        if $add_drop_table;
    $create_statement .= qq[CREATE TABLE $qt$table_name_ur$qt (\n].
                            join( ",\n", map { "  $_" } @field_defs, @constraint_defs ).
                            "\n);"
                            ;

    $create_statement .= "\n" . join(";\n", @index_defs) . "\n";
    
    return $create_statement, \@fks;
}

{ 

    my %field_name_scope;

    sub create_field
    {
        my ($field, $options) = @_;

        my $qt = $options->{quote_table_names} || '';
        my $qf = $options->{quote_field_names} || '';
        my $table_name = $field->table->name;
        my $constraint_defs = $options->{constraint_defs} || [];

        $field_name_scope{$table_name} ||= {};
        my $field_name    = mk_name(
                                    $field->name, '', $field_name_scope{$table_name}, 1 
                                    );
        my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
        $field->name($field_name_ur);
        my $field_comments = $field->comments 
            ? "-- " . $field->comments . "\n  " 
            : '';

        my $field_def     = $field_comments.qq[$qf$field_name_ur$qf];

        #
        # Datatype
        #
        my @size      = $field->size;
        my $data_type = lc $field->data_type;
        my %extra     = $field->extra;
        my $list      = $extra{'list'} || [];
        # todo deal with embedded quotes
        my $commalist = join( ', ', map { qq['$_'] } @$list );
        my $seq_name;

        $field_def .= ' '. convert_datatype($field);

        #
        # Default value -- disallow for timestamps
        #
#        my $default = $data_type =~ /(timestamp|date)/i
#            ? undef : $field->default_value;
        my $default = $field->default_value;
        if ( defined $default ) {
            my $qd = "'";
            $qd = '' if ($default eq 'now()' || 
                         $default eq 'CURRENT_TIMESTAMP');
            $field_def .= sprintf( ' DEFAULT %s',
                                   ( $field->is_auto_increment && $seq_name )
                                   ? qq[nextval('"$seq_name"'::text)] :
                                   ( $default =~ m/null/i ) ? 'NULL' : "$qd$default$qd"
                                   );
        }

        #
        # Not null constraint
        #
        $field_def .= ' NOT NULL' unless $field->is_nullable;

        return $field_def;
    }
}

{
    my %used_index_names;

    sub create_index
    {
        my ($index, $options) = @_;

        my $qt = $options->{quote_table_names} ||'';
        my $qf = $options->{quote_field_names} ||'';
        my $table_name = $index->table->name;
#        my $table_name_ur = $qt ? unreserve($table_name) : $table_name;

        my ($index_def, @constraint_defs);

        $used_index_names{$table_name} ||= {};
        my $name = $index->name || '';
        if ( $name ) {
            $name = next_unused_name($name, $used_index_names{$table_name});
            $used_index_names{$name} = $name;
        }

        my $type = $index->type || NORMAL;
        my @fields     = 
            map { $_ =~ s/\(.+\)//; $_ }
        map { $qt ? $_ : unreserve($_, $table_name ) }
        $index->fields;
        next unless @fields;

        my $def_start = qq[Constraint "$name" ];
        if ( $type eq PRIMARY_KEY ) {
            push @constraint_defs, "${def_start}PRIMARY KEY ".
                '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
        }
        elsif ( $type eq UNIQUE ) {
            push @constraint_defs, "${def_start}UNIQUE " .
                '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
        }
        elsif ( $type eq NORMAL ) {
            $index_def = 
                "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
                join( ', ', map { qq[$qf$_$qf] } @fields ).  
                ');'
                ; 
        }
        else {
            warn "Unknown index type ($type) on table $table_name.\n"
                if $WARN;
        }

        return $index_def, \@constraint_defs;
    }

    sub create_constraint
    {
        my ($c, $options) = @_;

        my $qf = $options->{quote_field_names} ||'';
        my $qt = $options->{quote_table_names} ||'';
        my $table_name = $c->table->name;
        my (@constraint_defs, @fks);

        my $name = $c->name || '';
        if ( $name ) {
            $name = next_unused_name($name, \%used_index_names);
            $used_index_names{$name} = $name;
        }

        my @fields     = 
            map { $_ =~ s/\(.+\)//; $_ }
        map { $qt ? $_ : unreserve( $_, $table_name )}
        $c->fields;

        my @rfields     = 
            map { $_ =~ s/\(.+\)//; $_ }
        map { $qt ? $_ : unreserve( $_, $table_name )}
        $c->reference_fields;

        next if !@fields && $c->type ne CHECK_C;
        my $def_start = $name ? qq[Constraint "$name" ] : '';
        if ( $c->type eq PRIMARY_KEY ) {
            push @constraint_defs, "${def_start}PRIMARY KEY ".
                '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
        }
        elsif ( $c->type eq UNIQUE ) {
            $name = next_unused_name($name, \%used_index_names);
            $used_index_names{$name} = $name;
            push @constraint_defs, "${def_start}UNIQUE " .
                '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
        }
        elsif ( $c->type eq CHECK_C ) {
            my $expression = $c->expression;
            push @constraint_defs, "${def_start}CHECK ($expression)";
        }
        elsif ( $c->type eq FOREIGN_KEY ) {
            my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" . 
                join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
                "\n  REFERENCES " . $qt . $c->reference_table . $qt;

            if ( @rfields ) {
                $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
            }

            if ( $c->match_type ) {
                $def .= ' MATCH ' . 
                    ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
            }

            if ( $c->on_delete ) {
                $def .= ' ON DELETE '.join( ' ', $c->on_delete );
            }

            if ( $c->on_update ) {
                $def .= ' ON UPDATE '.join( ' ', $c->on_update );
            }

            push @fks, "$def;";
        }

        return \@constraint_defs, \@fks;
    }
}

sub convert_datatype
{
    my ($field) = @_;

    my @size      = $field->size;
    my $data_type = lc $field->data_type;

    if ( $data_type eq 'enum' ) {
#        my $len = 0;
#        $len = ($len < length($_)) ? length($_) : $len for (@$list);
#        my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
#        push @$constraint_defs, 
#        qq[Constraint "$chk_name" CHECK ($qf$field_name$qf ].
#           qq[IN ($commalist))];
        $data_type = 'character varying';
    }
    elsif ( $data_type eq 'set' ) {
        $data_type = 'character varying';
    }
    elsif ( $field->is_auto_increment ) {
        if ( defined $size[0] && $size[0] > 11 ) {
            $data_type = 'bigserial';
        }
        else {
            $data_type = 'serial';
        }
        undef @size;
    }
    else {
        $data_type  = defined $translate{ $data_type } ?
            $translate{ $data_type } :
            $data_type;
    }

    if ( $data_type =~ /timestamp/i ) {
        if ( defined $size[0] && $size[0] > 6 ) {
            $size[0] = 6;
        }
    }

    if ( $data_type eq 'integer' ) {
        if ( defined $size[0] && $size[0] > 0) {
            if ( $size[0] > 10 ) {
                $data_type = 'bigint';
            }
            elsif ( $size[0] < 5 ) {
                $data_type = 'smallint';
            }
            else {
                $data_type = 'integer';
            }
        }
        else {
            $data_type = 'integer';
        }
    }

    #
    # PG doesn't need a size for integers or text
    #
    undef @size if $data_type =~ m/(integer|smallint|bigint|text)/;
    
    if ( defined $size[0] && $size[0] > 0 ) {
        $data_type .= '(' . join( ',', @size ) . ')';
    }
    elsif (defined $size[0] && $data_type eq 'timestamp' ) {
        $data_type .= '(' . join( ',', @size ) . ')';
    }


    return $data_type;
}


sub alter_field
{
    my ($from_field, $to_field) = @_;

    die "Can't alter field in another table" 
        if($from_field->table->name ne $to_field->table->name);

    my @out;
    push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL;',
                       $to_field->table->name,
                       $to_field->name) if(!$to_field->is_nullable and
                                           $from_field->is_nullable);

    my $from_dt = convert_datatype($from_field);
    my $to_dt   = convert_datatype($to_field);
    push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s;',
                       $to_field->table->name,
                       $to_field->name,
                       $to_dt) if($to_dt ne $from_dt);

    push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s;',
                       $to_field->table->name,
                       $from_field->name,
                       $to_field->name) if($from_field->name ne $to_field->name);

    push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s;',
                       $to_field->table->name,
                       $to_field->name,
                       $to_field->default_value) 
        if(defined $to_field->default_value && 
           $from_field->default_value ne $to_field->default_value);

    return wantarray ? @out : join("\n", @out);
    
}

sub add_field
{
    my ($new_field) = @_;

    my $out = sprintf('ALTER TABLE %s ADD COLUMN %s;',
                      $new_field->table->name,
                      create_field($new_field));
    return $out;

}

sub drop_field
{
    my ($old_field) = @_;

    my $out = sprintf('ALTER TABLE %s DROP COLUMN %s;',
                      $old_field->table->name,
                      $old_field->name);

    return $out;    
}

1;

# -------------------------------------------------------------------
# Life is full of misery, loneliness, and suffering --
# and it's all over much too soon.
# Woody Allen
# -------------------------------------------------------------------

=pod

=head1 SEE ALSO

SQL::Translator, SQL::Translator::Producer::Oracle.

=head1 AUTHOR

Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.

=cut
Commit	Line	Data
f8f0253c	1	package SQL::Translator::Producer::PostgreSQL;
	2
	3	# -------------------------------------------------------------------
cc00c034	4	# $Id: PostgreSQL.pm,v 1.28 2006-11-20 23:56:14 schiffbruechige Exp $
f8f0253c	5	# -------------------------------------------------------------------
977651a5	6	# Copyright (C) 2002-4 SQLFairy Authors
f8f0253c	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
96844cae	23	=head1 NAME
	24
	25	SQL::Translator::Producer::PostgreSQL - PostgreSQL producer for SQL::Translator
	26
20770e44	27	=head1 SYNOPSIS
	28
	29	my $t = SQL::Translator->new( parser => '...', producer => 'PostgreSQL' );
	30	$t->translate;
	31
	32	=head1 DESCRIPTION
	33
	34	Creates a DDL suitable for PostgreSQL. Very heavily based on the Oracle
	35	producer.
	36
96844cae	37	=cut
96844cae	38
f8f0253c	39	use strict;
bfb5a568	40	use warnings;
96844cae	41	use vars qw[ $DEBUG $WARN $VERSION ];
cc00c034	42	$VERSION = sprintf "%d.%02d", q$Revision: 1.28 $ =~ /(\d+)\.(\d+)/;
f8f0253c	43	$DEBUG = 1 unless defined $DEBUG;
f8f0253c	44
0c43e0a1	45	use SQL::Translator::Schema::Constants;
5ee19df8	46	use SQL::Translator::Utils qw(header_comment);
f8f0253c	47	use Data::Dumper;
f8f0253c	48
bfb5a568	49	my %translate;
	50	my $max_id_length;
	51
	52	BEGIN {
	53
	54	%translate = (
d529894e	55	#
	56	# MySQL types
	57	#
	58	bigint => 'bigint',
4328d7bd	59	double => 'numeric',
	60	decimal => 'numeric',
	61	float => 'numeric',
d529894e	62	int => 'integer',
	63	mediumint => 'integer',
	64	smallint => 'smallint',
	65	tinyint => 'smallint',
c8c17a58	66	char => 'character',
da8e499e	67	varchar => 'character varying',
d529894e	68	longtext => 'text',
	69	mediumtext => 'text',
	70	text => 'text',
	71	tinytext => 'text',
	72	tinyblob => 'bytea',
	73	blob => 'bytea',
	74	mediumblob => 'bytea',
	75	longblob => 'bytea',
da8e499e	76	enum => 'character varying',
da8e499e	77	set => 'character varying',
d529894e	78	date => 'date',
	79	datetime => 'timestamp',
	80	time => 'date',
	81	timestamp => 'timestamp',
	82	year => 'date',
	83
	84	#
	85	# Oracle types
	86	#
96844cae	87	number => 'integer',
c8c17a58	88	char => 'character',
da8e499e	89	varchar2 => 'character varying',
96844cae	90	long => 'text',
	91	CLOB => 'bytea',
	92	date => 'date',
	93
	94	#
	95	# Sybase types
	96	#
	97	int => 'integer',
	98	money => 'money',
da8e499e	99	varchar => 'character varying',
96844cae	100	datetime => 'timestamp',
96844cae	101	text => 'text',
4328d7bd	102	real => 'numeric',
96844cae	103	comment => 'text',
	104	bit => 'bit',
	105	tinyint => 'smallint',
4328d7bd	106	float => 'numeric',
d529894e	107	);
d529894e	108
bfb5a568	109	$max_id_length = 62;
bfb5a568	110	}
96844cae	111	my %reserved = map { $_, 1 } qw[
	112	ALL ANALYSE ANALYZE AND ANY AS ASC
	113	BETWEEN BINARY BOTH
	114	CASE CAST CHECK COLLATE COLUMN CONSTRAINT CROSS
	115	CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER
	116	DEFAULT DEFERRABLE DESC DISTINCT DO
	117	ELSE END EXCEPT
	118	FALSE FOR FOREIGN FREEZE FROM FULL
	119	GROUP HAVING
	120	ILIKE IN INITIALLY INNER INTERSECT INTO IS ISNULL
	121	JOIN LEADING LEFT LIKE LIMIT
	122	NATURAL NEW NOT NOTNULL NULL
	123	OFF OFFSET OLD ON ONLY OR ORDER OUTER OVERLAPS
	124	PRIMARY PUBLIC REFERENCES RIGHT
	125	SELECT SESSION_USER SOME TABLE THEN TO TRAILING TRUE
	126	UNION UNIQUE USER USING VERBOSE WHEN WHERE
	127	];
d529894e	128
bfb5a568	129	# my $max_id_length = 62;
96844cae	130	my %used_identifiers = ();
	131	my %global_names;
	132	my %unreserve;
	133	my %truncated;
	134
	135	=pod
	136
	137	=head1 PostgreSQL Create Table Syntax
	138
	139	CREATE [ [ LOCAL ] { TEMPORARY \| TEMP } ] TABLE table_name (
	140	{ column_name data_type [ DEFAULT default_expr ] [ column_constraint [, ... ] ]
	141	\| table_constraint } [, ... ]
	142	)
	143	[ INHERITS ( parent_table [, ... ] ) ]
	144	[ WITH OIDS \| WITHOUT OIDS ]
	145
	146	where column_constraint is:
	147
	148	[ CONSTRAINT constraint_name ]
	149	{ NOT NULL \| NULL \| UNIQUE \| PRIMARY KEY \|
	150	CHECK (expression) \|
	151	REFERENCES reftable [ ( refcolumn ) ] [ MATCH FULL \| MATCH PARTIAL ]
	152	[ ON DELETE action ] [ ON UPDATE action ] }
	153	[ DEFERRABLE \| NOT DEFERRABLE ] [ INITIALLY DEFERRED \| INITIALLY IMMEDIATE ]
	154
	155	and table_constraint is:
	156
	157	[ CONSTRAINT constraint_name ]
	158	{ UNIQUE ( column_name [, ... ] ) \|
	159	PRIMARY KEY ( column_name [, ... ] ) \|
	160	CHECK ( expression ) \|
	161	FOREIGN KEY ( column_name [, ... ] ) REFERENCES reftable [ ( refcolumn [, ... ] ) ]
	162	[ MATCH FULL \| MATCH PARTIAL ] [ ON DELETE action ] [ ON UPDATE action ] }
	163	[ DEFERRABLE \| NOT DEFERRABLE ] [ INITIALLY DEFERRED \| INITIALLY IMMEDIATE ]
	164
da8e499e	165	=head1 Create Index Syntax
	166
	167	CREATE [ UNIQUE ] INDEX index_name ON table
	168	[ USING acc_method ] ( column [ ops_name ] [, ...] )
	169	[ WHERE predicate ]
	170	CREATE [ UNIQUE ] INDEX index_name ON table
	171	[ USING acc_method ] ( func_name( column [, ... ]) [ ops_name ] )
	172	[ WHERE predicate ]
	173
96844cae	174	=cut
f8f0253c	175
96844cae	176	# -------------------------------------------------------------------
f8f0253c	177	sub produce {
a1d94525	178	my $translator = shift;
	179	$DEBUG = $translator->debug;
	180	$WARN = $translator->show_warnings;
	181	my $no_comments = $translator->no_comments;
	182	my $add_drop_table = $translator->add_drop_table;
	183	my $schema = $translator->schema;
96844cae	184
bfb5a568	185	my $qt = '';
	186	$qt = '"' if ($translator->quote_table_names);
	187	my $qf = '';
	188	$qf = '"' if ($translator->quote_field_names);
	189
da8e499e	190	my $output;
5ee19df8	191	$output .= header_comment unless ($no_comments);
bfb5a568	192	# my %used_index_names;
96844cae	193
08d91aad	194	my (@table_defs, @fks);
0c43e0a1	195	for my $table ( $schema->get_tables ) {
08d91aad	196
	197	my ($table_def, $fks) = create_table($table,
	198	{ quote_table_names => $qt,
	199	quote_field_names => $qf,
	200	no_comments => $no_comments,
	201	add_drop_table => $add_drop_table,});
	202	push @table_defs, $table_def;
	203	push @fks, @$fks;
	204
da8e499e	205	}
da8e499e	206
bfb5a568	207	$output = join("\n\n", @table_defs);
08d91aad	208	if ( @fks ) {
08d91aad	209	$output .= "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
b08b5416	210	$output .= join( "\n\n", @fks ) . "\n";
08d91aad	211	}
021dbce8	212
da8e499e	213	if ( $WARN ) {
	214	if ( %truncated ) {
	215	warn "Truncated " . keys( %truncated ) . " names:\n";
	216	warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
	217	}
	218
	219	if ( %unreserve ) {
	220	warn "Encounted " . keys( %unreserve ) .
	221	" unsafe names in schema (reserved or invalid):\n";
	222	warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
	223	}
f8f0253c	224	}
f8f0253c	225
da8e499e	226	return $output;
f8f0253c	227	}
f8f0253c	228
96844cae	229	# -------------------------------------------------------------------
96844cae	230	sub mk_name {
0c43e0a1	231	my $basename = shift \|\| '';
	232	my $type = shift \|\| '';
	233	my $scope = shift \|\| '';
	234	my $critical = shift \|\| '';
96844cae	235	my $basename_orig = $basename;
bfb5a568	236	# my $max_id_length = 62;
2ad4c2c8	237	my $max_name = $type
	238	? $max_id_length - (length($type) + 1)
	239	: $max_id_length;
96844cae	240	$basename = substr( $basename, 0, $max_name )
	241	if length( $basename ) > $max_name;
	242	my $name = $type ? "${type}_$basename" : $basename;
	243
	244	if ( $basename ne $basename_orig and $critical ) {
	245	my $show_type = $type ? "+'$type'" : "";
	246	warn "Truncating '$basename_orig'$show_type to $max_id_length ",
	247	"character limit to make '$name'\n" if $WARN;
	248	$truncated{ $basename_orig } = $name;
	249	}
	250
	251	$scope \|\|= \%global_names;
	252	if ( my $prev = $scope->{ $name } ) {
	253	my $name_orig = $name;
	254	$name .= sprintf( "%02d", ++$prev );
	255	substr($name, $max_id_length - 3) = "00"
	256	if length( $name ) > $max_id_length;
	257
	258	warn "The name '$name_orig' has been changed to ",
	259	"'$name' to make it unique.\n" if $WARN;
	260
	261	$scope->{ $name_orig }++;
f8f0253c	262	}
96844cae	263
	264	$scope->{ $name }++;
	265	return $name;
	266	}
	267
	268	# -------------------------------------------------------------------
	269	sub unreserve {
0c43e0a1	270	my $name = shift \|\| '';
	271	my $schema_obj_name = shift \|\| '';
	272
96844cae	273	my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
	274
	275	# also trap fields that don't begin with a letter
bfb5a568	276	return $name if (!$reserved{ uc $name }) && $name =~ /^[a-z]/i;
96844cae	277
	278	if ( $schema_obj_name ) {
	279	++$unreserve{"$schema_obj_name.$name"};
	280	}
	281	else {
	282	++$unreserve{"$name (table name)"};
	283	}
	284
	285	my $unreserve = sprintf '%s_', $name;
	286	return $unreserve.$suffix;
f8f0253c	287	}
f8f0253c	288
50840472	289	# -------------------------------------------------------------------
	290	sub next_unused_name {
	291	my $name = shift \|\| '';
	292	my $used_names = shift \|\| '';
	293
	294	my %used_names = %$used_names;
	295
	296	if ( !defined($used_names{$name}) ) {
	297	$used_names{$name} = $name;
	298	return $name;
	299	}
	300
	301	my $i = 2;
	302	while ( defined($used_names{$name . $i}) ) {
	303	++$i;
	304	}
	305	$name .= $i;
	306	$used_names{$name} = $name;
	307	return $name;
	308	}
	309
bfb5a568	310	sub create_table
	311	{
	312	my ($table, $options) = @_;
	313
	314	my $qt = $options->{quote_table_names} \|\| '';
	315	my $qf = $options->{quote_field_names} \|\| '';
	316	my $no_comments = $options->{no_comments} \|\| 0;
	317	my $add_drop_table = $options->{add_drop_table} \|\| 0;
	318
	319	my $table_name = $table->name or next;
	320	$table_name = mk_name( $table_name, '', undef, 1 );
08d91aad	321	my $table_name_ur = $qt ? $table_name : unreserve($table_name);
bfb5a568	322	$table->name($table_name_ur);
	323
	324	# print STDERR "$table_name table_name\n";
	325	my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @fks );
	326
	327	push @comments, "--\n-- Table: $table_name_ur\n--" unless $no_comments;
	328
	329	if ( $table->comments and !$no_comments ){
	330	my $c = "-- Comments: \n-- ";
	331	$c .= join "\n-- ", $table->comments;
	332	$c .= "\n--";
	333	push @comments, $c;
	334	}
	335
	336	#
	337	# Fields
	338	#
	339	my %field_name_scope;
	340	for my $field ( $table->get_fields ) {
	341	push @field_defs, create_field($field, { quote_table_names => $qt,
	342	quote_field_names => $qf,
	343	table_name => $table_name_ur,
	344	constraint_defs => \@constraint_defs,});
	345	}
	346
	347	#
	348	# Index Declarations
	349	#
	350	my @index_defs = ();
	351	# my $idx_name_default;
	352	for my $index ( $table->get_indices ) {
	353	my ($idef, $constraints) = create_index($index,
	354	{
	355	quote_field_names => $qf,
	356	quote_table_names => $qt,
	357	table_name => $table_name,
	358	});
	359	push @index_defs, $idef;
	360	push @constraint_defs, @$constraints;
	361	}
	362
	363	#
	364	# Table constraints
	365	#
	366	my $c_name_default;
	367	for my $c ( $table->get_constraints ) {
	368	my ($cdefs, $fks) = create_constraint($c,
	369	{
	370	quote_field_names => $qf,
	371	quote_table_names => $qt,
	372	table_name => $table_name,
	373	});
	374	push @constraint_defs, @$cdefs;
	375	push @fks, @$fks;
	376	}
	377
	378	my $create_statement;
	379	$create_statement = join("\n", @comments);
cc00c034	380	$create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n]
bfb5a568	381	if $add_drop_table;
	382	$create_statement .= qq[CREATE TABLE $qt$table_name_ur$qt (\n].
	383	join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
	384	"\n);"
	385	;
bfb5a568	386
	387	$create_statement .= "\n" . join(";\n", @index_defs) . "\n";
	388
08d91aad	389	return $create_statement, \@fks;
bfb5a568	390	}
	391
	392	{
	393
	394	my %field_name_scope;
	395
	396	sub create_field
	397	{
	398	my ($field, $options) = @_;
	399
	400	my $qt = $options->{quote_table_names} \|\| '';
	401	my $qf = $options->{quote_field_names} \|\| '';
	402	my $table_name = $field->table->name;
	403	my $constraint_defs = $options->{constraint_defs} \|\| [];
	404
	405	$field_name_scope{$table_name} \|\|= {};
	406	my $field_name = mk_name(
	407	$field->name, '', $field_name_scope{$table_name}, 1
	408	);
08d91aad	409	my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
bfb5a568	410	$field->name($field_name_ur);
	411	my $field_comments = $field->comments
	412	? "-- " . $field->comments . "\n "
	413	: '';
	414
	415	my $field_def = $field_comments.qq[$qf$field_name_ur$qf];
	416
	417	#
	418	# Datatype
	419	#
	420	my @size = $field->size;
	421	my $data_type = lc $field->data_type;
	422	my %extra = $field->extra;
	423	my $list = $extra{'list'} \|\| [];
	424	# todo deal with embedded quotes
	425	my $commalist = join( ', ', map { qq['$_'] } @$list );
	426	my $seq_name;
	427
	428	$field_def .= ' '. convert_datatype($field);
	429
	430	#
	431	# Default value -- disallow for timestamps
	432	#
f39e9c12	433	# my $default = $data_type =~ /(timestamp\|date)/i
	434	# ? undef : $field->default_value;
	435	my $default = $field->default_value;
bfb5a568	436	if ( defined $default ) {
f39e9c12	437	my $qd = "'";
	438	$qd = '' if ($default eq 'now()' \|\|
	439	$default eq 'CURRENT_TIMESTAMP');
bfb5a568	440	$field_def .= sprintf( ' DEFAULT %s',
	441	( $field->is_auto_increment && $seq_name )
	442	? qq[nextval('"$seq_name"'::text)] :
f39e9c12	443	( $default =~ m/null/i ) ? 'NULL' : "$qd$default$qd"
bfb5a568	444	);
	445	}
	446
	447	#
	448	# Not null constraint
	449	#
	450	$field_def .= ' NOT NULL' unless $field->is_nullable;
	451
	452	return $field_def;
	453	}
	454	}
	455
	456	{
	457	my %used_index_names;
	458
	459	sub create_index
	460	{
	461	my ($index, $options) = @_;
	462
	463	my $qt = $options->{quote_table_names} \|\|'';
	464	my $qf = $options->{quote_field_names} \|\|'';
	465	my $table_name = $index->table->name;
08d91aad	466	# my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
bfb5a568	467
	468	my ($index_def, @constraint_defs);
	469
	470	$used_index_names{$table_name} \|\|= {};
	471	my $name = $index->name \|\| '';
	472	if ( $name ) {
	473	$name = next_unused_name($name, $used_index_names{$table_name});
	474	$used_index_names{$name} = $name;
	475	}
	476
	477	my $type = $index->type \|\| NORMAL;
	478	my @fields =
	479	map { $_ =~ s/\(.+\)//; $_ }
08d91aad	480	map { $qt ? $_ : unreserve($_, $table_name ) }
bfb5a568	481	$index->fields;
	482	next unless @fields;
	483
	484	my $def_start = qq[Constraint "$name" ];
	485	if ( $type eq PRIMARY_KEY ) {
	486	push @constraint_defs, "${def_start}PRIMARY KEY ".
	487	'(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
	488	}
	489	elsif ( $type eq UNIQUE ) {
	490	push @constraint_defs, "${def_start}UNIQUE " .
	491	'(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
	492	}
	493	elsif ( $type eq NORMAL ) {
	494	$index_def =
08d91aad	495	"CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
bfb5a568	496	join( ', ', map { qq[$qf$_$qf] } @fields ).
	497	');'
	498	;
	499	}
	500	else {
	501	warn "Unknown index type ($type) on table $table_name.\n"
	502	if $WARN;
	503	}
	504
	505	return $index_def, \@constraint_defs;
	506	}
	507
	508	sub create_constraint
	509	{
	510	my ($c, $options) = @_;
	511
	512	my $qf = $options->{quote_field_names} \|\|'';
	513	my $qt = $options->{quote_table_names} \|\|'';
	514	my $table_name = $c->table->name;
	515	my (@constraint_defs, @fks);
	516
	517	my $name = $c->name \|\| '';
	518	if ( $name ) {
	519	$name = next_unused_name($name, \%used_index_names);
	520	$used_index_names{$name} = $name;
	521	}
	522
	523	my @fields =
	524	map { $_ =~ s/\(.+\)//; $_ }
08d91aad	525	map { $qt ? $_ : unreserve( $_, $table_name )}
bfb5a568	526	$c->fields;
	527
	528	my @rfields =
	529	map { $_ =~ s/\(.+\)//; $_ }
08d91aad	530	map { $qt ? $_ : unreserve( $_, $table_name )}
bfb5a568	531	$c->reference_fields;
	532
	533	next if !@fields && $c->type ne CHECK_C;
	534	my $def_start = $name ? qq[Constraint "$name" ] : '';
	535	if ( $c->type eq PRIMARY_KEY ) {
	536	push @constraint_defs, "${def_start}PRIMARY KEY ".
	537	'('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
	538	}
	539	elsif ( $c->type eq UNIQUE ) {
	540	$name = next_unused_name($name, \%used_index_names);
	541	$used_index_names{$name} = $name;
	542	push @constraint_defs, "${def_start}UNIQUE " .
	543	'('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
	544	}
	545	elsif ( $c->type eq CHECK_C ) {
	546	my $expression = $c->expression;
	547	push @constraint_defs, "${def_start}CHECK ($expression)";
	548	}
	549	elsif ( $c->type eq FOREIGN_KEY ) {
	550	my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
	551	join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
	552	"\n REFERENCES " . $qt . $c->reference_table . $qt;
	553
	554	if ( @rfields ) {
	555	$def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
	556	}
	557
	558	if ( $c->match_type ) {
	559	$def .= ' MATCH ' .
	560	( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
	561	}
	562
	563	if ( $c->on_delete ) {
	564	$def .= ' ON DELETE '.join( ' ', $c->on_delete );
	565	}
	566
	567	if ( $c->on_update ) {
	568	$def .= ' ON UPDATE '.join( ' ', $c->on_update );
	569	}
	570
	571	push @fks, "$def;";
	572	}
	573
	574	return \@constraint_defs, \@fks;
	575	}
	576	}
	577
	578	sub convert_datatype
	579	{
	580	my ($field) = @_;
	581
	582	my @size = $field->size;
	583	my $data_type = lc $field->data_type;
	584
	585	if ( $data_type eq 'enum' ) {
	586	# my $len = 0;
	587	# $len = ($len < length($_)) ? length($_) : $len for (@$list);
	588	# my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
	589	# push @$constraint_defs,
	590	# qq[Constraint "$chk_name" CHECK ($qf$field_name$qf ].
	591	# qq[IN ($commalist))];
	592	$data_type = 'character varying';
	593	}
	594	elsif ( $data_type eq 'set' ) {
595	$data_type = 'character varying';
596	}
597	elsif ( $field->is_auto_increment ) {
598	if ( defined $size[0] && $size[0] > 11 ) {
599	$data_type = 'bigserial';
600	}
601	else {
602	$data_type = 'serial';
603	}
604	undef @size;
605	}
606	else {
607	$data_type = defined $translate{ $data_type } ?
608	$translate{ $data_type } :
609	$data_type;
610	}
611
612	if ( $data_type =~ /timestamp/i ) {
613	if ( defined $size[0] && $size[0] > 6 ) {
614	$size[0] = 6;
615	}
616	}
617
618	if ( $data_type eq 'integer' ) {
619	if ( defined $size[0] && $size[0] > 0) {
620	if ( $size[0] > 10 ) {
621	$data_type = 'bigint';
622	}
623	elsif ( $size[0] < 5 ) {
624	$data_type = 'smallint';
625	}
626	else {
627	$data_type = 'integer';
628	}
629	}
630	else {
631	$data_type = 'integer';
632	}
633	}
634
635	#
636	# PG doesn't need a size for integers or text
637	#
638	undef @size if $data_type =~ m/(integer\|smallint\|bigint\|text)/;
639
640	if ( defined $size[0] && $size[0] > 0 ) {
641	$data_type .= '(' . join( ',', @size ) . ')';
642	}
08d91aad	643	elsif (defined $size[0] && $data_type eq 'timestamp' ) {
	644	$data_type .= '(' . join( ',', @size ) . ')';
	645	}
bfb5a568	646
	647
	648	return $data_type;
	649	}
	650
	651
	652	sub alter_field
	653	{
	654	my ($from_field, $to_field) = @_;
	655
	656	die "Can't alter field in another table"
	657	if($from_field->table->name ne $to_field->table->name);
	658
	659	my @out;
	660	push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL;',
	661	$to_field->table->name,
	662	$to_field->name) if(!$to_field->is_nullable and
	663	$from_field->is_nullable);
	664
	665	my $from_dt = convert_datatype($from_field);
	666	my $to_dt = convert_datatype($to_field);
	667	push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s;',
	668	$to_field->table->name,
	669	$to_field->name,
	670	$to_dt) if($to_dt ne $from_dt);
	671
	672	push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s;',
	673	$to_field->table->name,
	674	$from_field->name,
	675	$to_field->name) if($from_field->name ne $to_field->name);
	676
	677	push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s;',
	678	$to_field->table->name,
	679	$to_field->name,
	680	$to_field->default_value)
	681	if(defined $to_field->default_value &&
	682	$from_field->default_value ne $to_field->default_value);
	683
	684	return wantarray ? @out : join("\n", @out);
	685
	686	}
	687
	688	sub add_field
	689	{
	690	my ($new_field) = @_;
	691
	692	my $out = sprintf('ALTER TABLE %s ADD COLUMN %s;',
	693	$new_field->table->name,
	694	create_field($new_field));
	695	return $out;
	696
	697	}
	698
	699	sub drop_field
	700	{
	701	my ($old_field) = @_;
	702
	703	my $out = sprintf('ALTER TABLE %s DROP COLUMN %s;',
	704	$old_field->table->name,
	705	$old_field->name);
	706
	707	return $out;
	708	}
	709
f8f0253c	710	1;
f8f0253c	711
96844cae	712	# -------------------------------------------------------------------
	713	# Life is full of misery, loneliness, and suffering --
	714	# and it's all over much too soon.
	715	# Woody Allen
	716	# -------------------------------------------------------------------
f8f0253c	717
96844cae	718	=pod
f8f0253c	719
20770e44	720	=head1 SEE ALSO
	721
	722	SQL::Translator, SQL::Translator::Producer::Oracle.
	723
f8f0253c	724	=head1 AUTHOR
f8f0253c	725
20770e44	726	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
f8f0253c	727
f8f0253c	728	=cut