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

package SQL::Translator::Producer::Oracle;

# -------------------------------------------------------------------
# $Id: Oracle.pm,v 1.34 2005-08-10 16:33:39 duality72 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::Oracle - Oracle SQL producer

=head1 SYNOPSIS

  use SQL::Translator;

  my $t = SQL::Translator->new( parser => '...', producer => 'Oracle' );
  print $translator->translate( $file );

=head1 DESCRIPTION

Creates an SQL DDL suitable for Oracle.

=cut

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

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

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

    #
    # PostgreSQL types
    #
    numeric             => 'number',
    'double precision'  => 'number',
    serial              => 'number',
    bigserial           => 'number',
    money               => 'number',
    character           => 'char',
    'character varying' => 'varchar2',
    bytea               => 'BLOB',
    interval            => 'number',
    boolean             => 'number',
    point               => 'number',
    line                => 'number',
    lseg                => 'number',
    box                 => 'number',
    path                => 'number',
    polygon             => 'number',
    circle              => 'number',
    cidr                => 'number',
    inet                => 'varchar2',
    macaddr             => 'varchar2',
    bit                 => 'number',
    'bit varying'       => 'number',

    #
    # Oracle types
    #
    number              => 'number',
    varchar2            => 'varchar2',
    long                => 'clob',
);

#
# Oracle reserved words from:
# http://technet.oracle.com/docs/products/oracle8i/doc_library/\
# 817_doc/server.817/a85397/ap_keywd.htm
#
my %ora_reserved = map { $_, 1 } qw(
    ACCESS ADD ALL ALTER AND ANY AS ASC AUDIT 
    BETWEEN BY
    CHAR CHECK CLUSTER COLUMN COMMENT COMPRESS CONNECT CREATE CURRENT
    DATE DECIMAL DEFAULT DELETE DESC DISTINCT DROP
    ELSE EXCLUSIVE EXISTS 
    FILE FLOAT FOR FROM
    GRANT GROUP 
    HAVING
    IDENTIFIED IMMEDIATE IN INCREMENT INDEX INITIAL INSERT
    INTEGER INTERSECT INTO IS
    LEVEL LIKE LOCK LONG 
    MAXEXTENTS MINUS MLSLABEL MODE MODIFY 
    NOAUDIT NOCOMPRESS NOT NOWAIT NULL NUMBER 
    OF OFFLINE ON ONLINE OPTION OR ORDER
    PCTFREE PRIOR PRIVILEGES PUBLIC
    RAW RENAME RESOURCE REVOKE ROW ROWID ROWNUM ROWS
    SELECT SESSION SET SHARE SIZE SMALLINT START 
    SUCCESSFUL SYNONYM SYSDATE 
    TABLE THEN TO TRIGGER 
    UID UNION UNIQUE UPDATE USER
    VALIDATE VALUES VARCHAR VARCHAR2 VIEW
    WHENEVER WHERE WITH
);

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

# -------------------------------------------------------------------
sub produce {
    my $translator     = shift;
    $DEBUG             = $translator->debug;
    $WARN              = $translator->show_warnings || 0;
    my $no_comments    = $translator->no_comments;
    my $add_drop_table = $translator->add_drop_table;
    my $schema         = $translator->schema;
    my $delay_constraints = $translator->producer_args->{delay_constraints};
    my ($output, $create, @table_defs, @fk_defs, @trigger_defs, @index_defs, @constraint_defs);

    $create .= header_comment unless ($no_comments);

    if ( $translator->parser_type =~ /mysql/i ) {
        $create .= 
            "-- We assume that default NLS_DATE_FORMAT has been changed\n".
            "-- but we set it here anyway to be self-consistent.\n"
            unless $no_comments;

        $create .= 
        "ALTER SESSION SET NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS';\n\n";
    }

    for my $table ( $schema->get_tables ) { 
        my ( $table_def, $fk_def, $trigger_def, $index_def, $constraint_def) = create_table(
            $table,
            {
                add_drop_table => $add_drop_table,
                show_warnings  => $WARN,
                no_comments    => $no_comments,
                delay_constraints => $delay_constraints
            }
        );
        push @table_defs, @$table_def;
        push @fk_defs, @$fk_def;
        push @trigger_defs, @$trigger_def;
        push @index_defs, @$index_def;
        push @constraint_defs, @$constraint_def;
    }

    my (@view_defs);
    foreach my $view ( $schema->get_views ) {
        push @view_defs, create_view($view);
    }

    return wantarray ? (defined $create ? $create : (), @table_defs, @view_defs, @fk_defs, @trigger_defs, @index_defs, @constraint_defs) : $create . join ("\n\n", @table_defs, @view_defs, @fk_defs, @trigger_defs, @index_defs, @constraint_defs, '');
}

sub create_table {
    my ($table, $options) = @_;
    my $table_name = $table->name;
    
    my $item = '';
    my $drop;
    my (@create, @field_defs, @constraint_defs, @fk_defs, @trigger_defs);

    push @create, "--\n-- Table: $table_name\n--" unless $options->{no_comments};
    push @create, qq[DROP TABLE $table_name CASCADE CONSTRAINTS;] if $options->{add_drop_table};

    my $table_name_ur = unreserve($table_name) or next;

        my ( %field_name_scope, @field_comments );
        for my $field ( $table->get_fields ) {
            #
            # Field name
            #
            my $field_name    = mk_name(
                $field->name, '', \%field_name_scope, 1 
            );
            my $field_name_ur = unreserve( $field_name, $table_name );
            my $field_def     = $field_name_ur;
            $field->name( $field_name_ur );

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

            if ( $data_type eq 'enum' ) {
                $check = "CHECK ($field_name_ur IN ($commalist))";
                $data_type = 'varchar2';
            }
            elsif ( $data_type eq 'set' ) {
                # XXX add a CHECK constraint maybe 
                # (trickier and slower, than enum :)
                $data_type = 'varchar2';
            }
            else {
                $data_type  = defined $translate{ $data_type } ?
                              $translate{ $data_type } :
                              $data_type;
                $data_type ||= 'varchar2';
            }
            
            #
            # Fixes ORA-02329: column of datatype LOB cannot be 
            # unique or a primary key
            #
            if ( $data_type eq 'clob' && $field->is_primary_key ) {
                $data_type = 'varchar2';
                $size[0]   = 4000;
                warn "CLOB cannot be a primary key, changing to VARCHAR2\n"
                    if $WARN;
            }

            if ( $data_type eq 'clob' && $field->is_unique ) {
                $data_type = 'varchar2';
                $size[0]   = 4000;
                warn "CLOB cannot be a unique key, changing to VARCHAR2\n"
                    if $WARN;
            }

            #
            # Fixes ORA-00907: missing right parenthesis
            #
            if ( $data_type =~ /(date|clob)/i ) {
                undef @size;
            }

            $field_def .= " $data_type";
            if ( defined $size[0] && $size[0] > 0 ) {
                $field_def .= '(' . join( ', ', @size ) . ')';
            }

            #
            # Default value
            #
            my $default = $field->default_value;
            if ( defined $default ) {
                #
                # Wherein we try to catch a string being used as 
                # a default value for a numerical field.  If "true/false,"
                # then sub "1/0," otherwise just test the truthity of the
                # argument and use that (naive?).
                #
                if ( 
                    $data_type =~ /^number$/i && 
                    $default   !~ /^-?\d+$/     &&
                    $default   !~ m/null/i
                ) {
                    if ( $default =~ /^true$/i ) {
                        $default = "'1'";
                    }
                    elsif ( $default =~ /^false$/i ) {
                        $default = "'0'";
                    }
                    else {
                        $default = $default ? "'1'" : "'0'";
                    }
                }
                elsif ( 
                    $data_type =~ /date/ && (
                        $default eq 'current_timestamp' 
                        ||
                        $default eq 'now()' 
                    )
                ) {
                    $default = 'SYSDATE';
                }
                else {
                    $default = $default =~ m/null/i ? 'NULL' : "'$default'"
                } 

                $field_def .= " DEFAULT $default",
            }

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

            $field_def .= " $check" if $check;

            #
            # Auto_increment
            #
            if ( $field->is_auto_increment ) {
                my $base_name    = $table_name_ur . "_". $field_name;
                my $seq_name     = mk_name( $base_name, 'sq' );
                my $trigger_name = mk_name( $base_name, 'ai' );

            push @create, qq[DROP SEQUENCE $seq_name;] if $options->{add_drop_table};
            push @create, "CREATE SEQUENCE $seq_name;";
                push @trigger_defs, 
                    "CREATE OR REPLACE TRIGGER $trigger_name\n" .
                    "BEFORE INSERT ON $table_name_ur\n" .
                    "FOR EACH ROW WHEN (\n" .
                        " new.$field_name_ur IS NULL".
                        " OR new.$field_name_ur = 0\n".
                    ")\n".
                    "BEGIN\n" .
                        " SELECT $seq_name.nextval\n" .
                        " INTO :new." . $field->name."\n" .
                        " FROM dual;\n" .
                    "END;\n/";
                ;
            }

            if ( lc $field->data_type eq 'timestamp' ) {
                my $base_name = $table_name_ur . "_". $field_name_ur;
                my $trig_name = mk_name( $base_name, 'ts' );
                push @trigger_defs, 
                    "CREATE OR REPLACE TRIGGER $trig_name\n".
                    "BEFORE INSERT OR UPDATE ON $table_name_ur\n".
                    "FOR EACH ROW WHEN (new.$field_name_ur IS NULL)\n".
                    "BEGIN \n".
                    " SELECT sysdate INTO :new.$field_name_ur FROM dual;\n".
                    "END;\n/";
            }

            push @field_defs, $field_def;

            if ( my $comment = $field->comments ) {
                $comment =~ s/'/''/g;
                push @field_comments, 
                    "COMMENT ON COLUMN $table_name_ur.$field_name_ur is\n '" .
                $comment . "';" unless $options->{no_comments};
            }
        }

        #
        # Table options
        #
        my @table_options;
        for my $opt ( $table->options ) {
            if ( ref $opt eq 'HASH' ) {
                my ( $key, $value ) = each %$opt;
                if ( ref $value eq 'ARRAY' ) {
                    push @table_options, "$key\n(\n".  join ("\n",
                        map { "  $_->[0]\t$_->[1]" } 
                        map { [ each %$_ ] }
                        @$value
                    )."\n)";
                }
                elsif ( !defined $value ) {
                    push @table_options, $key;
                }
                else {
                    push @table_options, "$key    $value";
                }
            }
        }

        #
        # Table constraints
        #
        for my $c ( $table->get_constraints ) {
            my $name    = $c->name || '';
            my @fields  = map { unreserve( $_, $table_name ) } $c->fields;
            my @rfields = map { unreserve( $_, $table_name ) } 
                $c->reference_fields;
            next if !@fields && $c->type ne CHECK_C;

            if ( $c->type eq PRIMARY_KEY ) {
                #$name ||= mk_name( $table_name, 'pk' );
                push @constraint_defs, ($name ? "CONSTRAINT $name " : '') .
                	'PRIMARY KEY (' . join( ', ', @fields ) . ')';
            }
            elsif ( $c->type eq UNIQUE ) {
            	# Don't create UNIQUE constraints identical to the primary key
            	if ( my $pk = $table->primary_key ) {
					my $u_fields = join(":", @fields);
					my $pk_fields = join(":", $pk->fields);
					next if $u_fields eq $pk_fields;
            	}

                $name ||= mk_name( $name || $table_name, 'u' );

                for my $f ( $c->fields ) {
                    my $field_def = $table->get_field( $f ) or next;
                    my $dtype     = $translate{ $field_def->data_type } or next;
                    if ( $WARN && $dtype =~ /clob/i ) {
                        warn "Oracle will not allow UNIQUE constraints on " .
                             "CLOB field '" . $field_def->table->name . '.' .
                             $field_def->name . ".'\n"
                    }
                }

                push @constraint_defs, "CONSTRAINT $name UNIQUE " .
                    '(' . join( ', ', @fields ) . ')';
            }
            elsif ( $c->type eq CHECK_C ) {
                $name ||= mk_name( $name || $table_name, 'ck' );
                my $expression = $c->expression || '';
                push @constraint_defs, "CONSTRAINT $name CHECK ($expression)";
            }
            elsif ( $c->type eq FOREIGN_KEY ) {
            $name = mk_name( join('_', $table_name, $c->fields). '_fk' );
                my $def = "CONSTRAINT $name FOREIGN KEY ";

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

                my $ref_table = unreserve($c->reference_table);

                $def .= " REFERENCES $ref_table";

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

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

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

            # disabled by plu 2007-12-29 - doesn't exist for oracle
            #if ( $c->on_update ) {
            #    $def .= ' ON UPDATE '.join( ' ', $c->on_update );
            #}

            push @fk_defs, sprintf("ALTER TABLE %s ADD %s;", $table, $def);
            }
        }

        #
        # Index Declarations
        #
        my @index_defs = ();
        for my $index ( $table->get_indices ) {
            my $index_name = $index->name || '';
            my $index_type = $index->type || NORMAL;
            my @fields     = map { unreserve( $_, $table_name ) }
                             $index->fields;
            next unless @fields;

            my @index_options;
            for my $opt ( $index->options ) {
                if ( ref $opt eq 'HASH' ) {
                    my ( $key, $value ) = each %$opt;
                    if ( ref $value eq 'ARRAY' ) {
                        push @table_options, "$key\n(\n".  join ("\n",
                            map { "  $_->[0]\t$_->[1]" } 
                            map { [ each %$_ ] }
                           @$value
                        )."\n)";
                    }
                    elsif ( !defined $value ) {
                        push @index_options, $key;
                    }
                    else {
                        push @index_options, "$key    $value";
                    }
                }
            }
            my $index_options = @index_options
              ? "\n".join("\n", @index_options) : '';

            if ( $index_type eq PRIMARY_KEY ) {
                $index_name = $index_name ? mk_name( $index_name ) 
                    : mk_name( $table_name, 'pk' );
                push @field_defs, 'CONSTRAINT '.$index_name.' PRIMARY KEY '.
                    '(' . join( ', ', @fields ) . ')';
            }
            elsif ( $index_type eq NORMAL ) {
                $index_name = $index_name ? mk_name( $index_name ) 
                    : mk_name( $table_name, $index_name || 'i' );
                push @index_defs, 
                    "CREATE INDEX $index_name on $table_name_ur (".
                        join( ', ', @fields ).  
                    ")$index_options;";
            }
            elsif ( $index_type eq UNIQUE ) {
                $index_name = $index_name ? mk_name( $index_name ) 
                    : mk_name( $table_name, $index_name || 'i' );
                push @index_defs, 
                    "CREATE UNIQUE INDEX $index_name on $table_name_ur (".
                        join( ', ', @fields ).  
                    ")$index_options;"; 
            }
            else {
                warn "Unknown index type ($index_type) on table $table_name.\n"
                    if $WARN;
            }
        }

        if ( my @table_comments = $table->comments ) {
            for my $comment ( @table_comments ) {
                next unless $comment;
                $comment =~ s/'/''/g;
                push @field_comments, "COMMENT ON TABLE $table_name_ur is\n '".
                $comment . "';" unless $options->{no_comments}
                ;
            }
        }

        my $table_options = @table_options 
            ? "\n".join("\n", @table_options) : '';
    push @create, "CREATE TABLE $table_name_ur (\n" .
            join( ",\n", map { "  $_" } @field_defs,
            ($options->{delay_constraints} ? () : @constraint_defs) ) .
            "\n)$table_options;";

    @constraint_defs = map { 'ALTER TABLE '.$table_name_ur.' ADD '.$_  }
      @constraint_defs;

    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 \@create, \@fk_defs, \@trigger_defs, \@index_defs, ($options->{delay_constraints} ? \@constraint_defs : []);
}

sub create_view {
    my ($view) = @_;

    my $out = sprintf("CREATE VIEW %s AS\n%s;",
                      $view->name,
                      $view->sql);

    return $out;
}

# -------------------------------------------------------------------
sub mk_name {
    my $basename      = shift || ''; 
    my $type          = shift || ''; 
       $type          = '' if $type =~ /^\d/;
    my $scope         = shift || ''; 
    my $critical      = shift || '';
    my $basename_orig = $basename;
    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;
        substr($name, $max_id_length - 2) = ""
            if length( $name ) >= $max_id_length - 1;
        $name        .= sprintf( "%02d", $prev++ );

        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 !$ora_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;
}

1;

# -------------------------------------------------------------------
# All bad art is the result of good intentions.
# Oscar Wilde
# -------------------------------------------------------------------

=pod

=head1 CREDITS

Mad props to Tim Bunce for much of the logic stolen from his "mysql2ora"
script.

=head1 AUTHOR

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

=head1 SEE ALSO

SQL::Translator, DDL::Oracle, mysql2ora.

=cut
Commit	Line	Data
16dc9970	1	package SQL::Translator::Producer::Oracle;
16dc9970	2
077ebf34	3	# -------------------------------------------------------------------
54e61f1f	4	# $Id: Oracle.pm,v 1.34 2005-08-10 16:33:39 duality72 Exp $
077ebf34	5	# -------------------------------------------------------------------
977651a5	6	# Copyright (C) 2002-4 SQLFairy Authors
16dc9970	7	#
077ebf34	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
ba096dc4	23	=head1 NAME
	24
	25	SQL::Translator::Producer::Oracle - Oracle SQL producer
	26
	27	=head1 SYNOPSIS
	28
	29	use SQL::Translator;
	30
	31	my $t = SQL::Translator->new( parser => '...', producer => 'Oracle' );
	32	print $translator->translate( $file );
	33
	34	=head1 DESCRIPTION
	35
	36	Creates an SQL DDL suitable for Oracle.
	37
	38	=cut
	39
16dc9970	40	use strict;
96844cae	41	use vars qw[ $VERSION $DEBUG $WARN ];
54e61f1f	42	$VERSION = sprintf "%d.%02d", q$Revision: 1.34 $ =~ /(\d+)\.(\d+)/;
d529894e	43	$DEBUG = 0 unless defined $DEBUG;
16dc9970	44
57f77285	45	use SQL::Translator::Schema::Constants;
5ee19df8	46	use SQL::Translator::Utils qw(header_comment);
5ee19df8	47
16dc9970	48	my %translate = (
d529894e	49	#
	50	# MySQL types
	51	#
16dc9970	52	bigint => 'number',
	53	double => 'number',
	54	decimal => 'number',
	55	float => 'number',
	56	int => 'number',
25966689	57	integer => 'number',
16dc9970	58	mediumint => 'number',
	59	smallint => 'number',
	60	tinyint => 'number',
16dc9970	61	char => 'char',
16dc9970	62	varchar => 'varchar2',
1f58ba76	63	tinyblob => 'blob',
	64	blob => 'blob',
	65	mediumblob => 'blob',
	66	longblob => 'blob',
9fc9bfb1	67	tinytext => 'varchar2',
9fc9bfb1	68	text => 'clob',
1f58ba76	69	longtext => 'clob',
1f58ba76	70	mediumtext => 'clob',
16dc9970	71	enum => 'varchar2',
16dc9970	72	set => 'varchar2',
16dc9970	73	date => 'date',
	74	datetime => 'date',
	75	time => 'date',
	76	timestamp => 'date',
	77	year => 'date',
d529894e	78
	79	#
	80	# PostgreSQL types
	81	#
57f77285	82	numeric => 'number',
	83	'double precision' => 'number',
	84	serial => 'number',
	85	bigserial => 'number',
	86	money => 'number',
	87	character => 'char',
	88	'character varying' => 'varchar2',
	89	bytea => 'BLOB',
	90	interval => 'number',
	91	boolean => 'number',
	92	point => 'number',
	93	line => 'number',
	94	lseg => 'number',
	95	box => 'number',
	96	path => 'number',
	97	polygon => 'number',
	98	circle => 'number',
	99	cidr => 'number',
	100	inet => 'varchar2',
	101	macaddr => 'varchar2',
	102	bit => 'number',
	103	'bit varying' => 'number',
ab8802d7	104
	105	#
	106	# Oracle types
	107	#
	108	number => 'number',
	109	varchar2 => 'varchar2',
	110	long => 'clob',
d529894e	111	);
	112
	113	#
	114	# Oracle reserved words from:
	115	# http://technet.oracle.com/docs/products/oracle8i/doc_library/\
	116	# 817_doc/server.817/a85397/ap_keywd.htm
	117	#
96844cae	118	my %ora_reserved = map { $_, 1 } qw(
d529894e	119	ACCESS ADD ALL ALTER AND ANY AS ASC AUDIT
	120	BETWEEN BY
	121	CHAR CHECK CLUSTER COLUMN COMMENT COMPRESS CONNECT CREATE CURRENT
	122	DATE DECIMAL DEFAULT DELETE DESC DISTINCT DROP
	123	ELSE EXCLUSIVE EXISTS
	124	FILE FLOAT FOR FROM
	125	GRANT GROUP
	126	HAVING
	127	IDENTIFIED IMMEDIATE IN INCREMENT INDEX INITIAL INSERT
	128	INTEGER INTERSECT INTO IS
	129	LEVEL LIKE LOCK LONG
	130	MAXEXTENTS MINUS MLSLABEL MODE MODIFY
	131	NOAUDIT NOCOMPRESS NOT NOWAIT NULL NUMBER
	132	OF OFFLINE ON ONLINE OPTION OR ORDER
	133	PCTFREE PRIOR PRIVILEGES PUBLIC
	134	RAW RENAME RESOURCE REVOKE ROW ROWID ROWNUM ROWS
	135	SELECT SESSION SET SHARE SIZE SMALLINT START
	136	SUCCESSFUL SYNONYM SYSDATE
	137	TABLE THEN TO TRIGGER
	138	UID UNION UNIQUE UPDATE USER
	139	VALIDATE VALUES VARCHAR VARCHAR2 VIEW
	140	WHENEVER WHERE WITH
16dc9970	141	);
16dc9970	142
96844cae	143	my $max_id_length = 30;
96844cae	144	my %used_identifiers = ();
d529894e	145	my %global_names;
	146	my %unreserve;
	147	my %truncated;
16dc9970	148
96844cae	149	# -------------------------------------------------------------------
077ebf34	150	sub produce {
a1d94525	151	my $translator = shift;
a1d94525	152	$DEBUG = $translator->debug;
e56dabb7	153	$WARN = $translator->show_warnings \|\| 0;
a1d94525	154	my $no_comments = $translator->no_comments;
	155	my $add_drop_table = $translator->add_drop_table;
	156	my $schema = $translator->schema;
65ffb46c	157	my $delay_constraints = $translator->producer_args->{delay_constraints};
65ffb46c	158	my ($output, $create, @table_defs, @fk_defs, @trigger_defs, @index_defs, @constraint_defs);
44fcd0b5	159
e56dabb7	160	$create .= header_comment unless ($no_comments);
077ebf34	161
d529894e	162	if ( $translator->parser_type =~ /mysql/i ) {
e56dabb7	163	$create .=
ba3cb849	164	"-- We assume that default NLS_DATE_FORMAT has been changed\n".
	165	"-- but we set it here anyway to be self-consistent.\n"
	166	unless $no_comments;
	167
e56dabb7	168	$create .=
d529894e	169	"ALTER SESSION SET NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS';\n\n";
d529894e	170	}
16dc9970	171
57f77285	172	for my $table ( $schema->get_tables ) {
65ffb46c	173	my ( $table_def, $fk_def, $trigger_def, $index_def, $constraint_def) = create_table(
e56dabb7	174	$table,
	175	{
	176	add_drop_table => $add_drop_table,
	177	show_warnings => $WARN,
	178	no_comments => $no_comments,
65ffb46c	179	delay_constraints => $delay_constraints
e56dabb7	180	}
	181	);
	182	push @table_defs, @$table_def;
	183	push @fk_defs, @$fk_def;
	184	push @trigger_defs, @$trigger_def;
041e659f	185	push @index_defs, @$index_def;
65ffb46c	186	push @constraint_defs, @$constraint_def;
e56dabb7	187	}
	188
	189	my (@view_defs);
	190	foreach my $view ( $schema->get_views ) {
	191	push @view_defs, create_view($view);
	192	}
	193
65ffb46c	194	return wantarray ? (defined $create ? $create : (), @table_defs, @view_defs, @fk_defs, @trigger_defs, @index_defs, @constraint_defs) : $create . join ("\n\n", @table_defs, @view_defs, @fk_defs, @trigger_defs, @index_defs, @constraint_defs, '');
e56dabb7	195	}
	196
	197	sub create_table {
	198	my ($table, $options) = @_;
	199	my $table_name = $table->name;
	200
	201	my $item = '';
	202	my $drop;
	203	my (@create, @field_defs, @constraint_defs, @fk_defs, @trigger_defs);
16dc9970	204
e56dabb7	205	push @create, "--\n-- Table: $table_name\n--" unless $options->{no_comments};
e56dabb7	206	push @create, qq[DROP TABLE $table_name CASCADE CONSTRAINTS;] if $options->{add_drop_table};
16dc9970	207
e56dabb7	208	my $table_name_ur = unreserve($table_name) or next;
16dc9970	209
f6195129	210	my ( %field_name_scope, @field_comments );
57f77285	211	for my $field ( $table->get_fields ) {
16dc9970	212	#
	213	# Field name
	214	#
44fcd0b5	215	my $field_name = mk_name(
57f77285	216	$field->name, '', \%field_name_scope, 1
44fcd0b5	217	);
44fcd0b5	218	my $field_name_ur = unreserve( $field_name, $table_name );
57f77285	219	my $field_def = $field_name_ur;
ef373e64	220	$field->name( $field_name_ur );
16dc9970	221
	222	#
	223	# Datatype
	224	#
44fcd0b5	225	my $check;
57f77285	226	my $data_type = lc $field->data_type;
	227	my @size = $field->size;
	228	my %extra = $field->extra;
	229	my $list = $extra{'list'} \|\| [];
77d74ea6	230	# \todo deal with embedded quotes
e6f063bd	231	my $commalist = join( ', ', map { qq['$_'] } @$list );
44fcd0b5	232
44fcd0b5	233	if ( $data_type eq 'enum' ) {
1f58ba76	234	$check = "CHECK ($field_name_ur IN ($commalist))";
57f77285	235	$data_type = 'varchar2';
44fcd0b5	236	}
	237	elsif ( $data_type eq 'set' ) {
	238	# XXX add a CHECK constraint maybe
	239	# (trickier and slower, than enum :)
57f77285	240	$data_type = 'varchar2';
44fcd0b5	241	}
	242	else {
	243	$data_type = defined $translate{ $data_type } ?
	244	$translate{ $data_type } :
0a91d33e	245	$data_type;
0a91d33e	246	$data_type \|\|= 'varchar2';
44fcd0b5	247	}
1f58ba76	248
e6f063bd	249	#
	250	# Fixes ORA-02329: column of datatype LOB cannot be
	251	# unique or a primary key
	252	#
1f58ba76	253	if ( $data_type eq 'clob' && $field->is_primary_key ) {
1f58ba76	254	$data_type = 'varchar2';
9fc9bfb1	255	$size[0] = 4000;
e6f063bd	256	warn "CLOB cannot be a primary key, changing to VARCHAR2\n"
e6f063bd	257	if $WARN;
1f58ba76	258	}
1f58ba76	259
ef373e64	260	if ( $data_type eq 'clob' && $field->is_unique ) {
	261	$data_type = 'varchar2';
	262	$size[0] = 4000;
	263	warn "CLOB cannot be a unique key, changing to VARCHAR2\n"
	264	if $WARN;
	265	}
	266
9fc9bfb1	267	#
1f58ba76	268	# Fixes ORA-00907: missing right parenthesis
9fc9bfb1	269	#
9fc9bfb1	270	if ( $data_type =~ /(date\|clob)/i ) {
1f58ba76	271	undef @size;
1f58ba76	272	}
16dc9970	273
57f77285	274	$field_def .= " $data_type";
	275	if ( defined $size[0] && $size[0] > 0 ) {
	276	$field_def .= '(' . join( ', ', @size ) . ')';
	277	}
1f58ba76	278
16dc9970	279	#
	280	# Default value
	281	#
57f77285	282	my $default = $field->default_value;
57f77285	283	if ( defined $default ) {
1c899510	284	#
	285	# Wherein we try to catch a string being used as
	286	# a default value for a numerical field. If "true/false,"
	287	# then sub "1/0," otherwise just test the truthity of the
	288	# argument and use that (naive?).
	289	#
ab8802d7	290	if (
ab8802d7	291	$data_type =~ /^number$/i &&
54e61f1f	292	$default !~ /^-?\d+$/ &&
ab8802d7	293	$default !~ m/null/i
ab8802d7	294	) {
1c899510	295	if ( $default =~ /^true$/i ) {
	296	$default = "'1'";
	297	}
	298	elsif ( $default =~ /^false$/i ) {
	299	$default = "'0'";
	300	}
	301	else {
	302	$default = $default ? "'1'" : "'0'";
	303	}
	304	}
	305	elsif (
b0c196d4	306	$data_type =~ /date/ && (
	307	$default eq 'current_timestamp'
	308	\|\|
	309	$default eq 'now()'
	310	)
1c899510	311	) {
	312	$default = 'SYSDATE';
	313	}
	314	else {
	315	$default = $default =~ m/null/i ? 'NULL' : "'$default'"
	316	}
	317
	318	$field_def .= " DEFAULT $default",
16dc9970	319	}
	320
	321	#
	322	# Not null constraint
	323	#
57f77285	324	unless ( $field->is_nullable ) {
02c2af3b	325	$field_def .= ' NOT NULL';
16dc9970	326	}
16dc9970	327
57f77285	328	$field_def .= " $check" if $check;
44fcd0b5	329
16dc9970	330	#
	331	# Auto_increment
	332	#
57f77285	333	if ( $field->is_auto_increment ) {
ef373e64	334	my $base_name = $table_name_ur . "_". $field_name;
44fcd0b5	335	my $seq_name = mk_name( $base_name, 'sq' );
44fcd0b5	336	my $trigger_name = mk_name( $base_name, 'ai' );
16dc9970	337
e56dabb7	338	push @create, qq[DROP SEQUENCE $seq_name;] if $options->{add_drop_table};
e56dabb7	339	push @create, "CREATE SEQUENCE $seq_name;";
57f77285	340	push @trigger_defs,
d529894e	341	"CREATE OR REPLACE TRIGGER $trigger_name\n" .
b0c196d4	342	"BEFORE INSERT ON $table_name_ur\n" .
44fcd0b5	343	"FOR EACH ROW WHEN (\n" .
	344	" new.$field_name_ur IS NULL".
	345	" OR new.$field_name_ur = 0\n".
	346	")\n".
d529894e	347	"BEGIN\n" .
44fcd0b5	348	" SELECT $seq_name.nextval\n" .
57f77285	349	" INTO :new." . $field->name."\n" .
16dc9970	350	" FROM dual;\n" .
44fcd0b5	351	"END;\n/";
16dc9970	352	;
	353	}
	354
57f77285	355	if ( lc $field->data_type eq 'timestamp' ) {
ef373e64	356	my $base_name = $table_name_ur . "_". $field_name_ur;
96844cae	357	my $trig_name = mk_name( $base_name, 'ts' );
57f77285	358	push @trigger_defs,
44fcd0b5	359	"CREATE OR REPLACE TRIGGER $trig_name\n".
44fcd0b5	360	"BEFORE INSERT OR UPDATE ON $table_name_ur\n".
b6ab0fe7	361	"FOR EACH ROW WHEN (new.$field_name_ur IS NULL)\n".
44fcd0b5	362	"BEGIN \n".
b6ab0fe7	363	" SELECT sysdate INTO :new.$field_name_ur FROM dual;\n".
44fcd0b5	364	"END;\n/";
	365	}
	366
57f77285	367	push @field_defs, $field_def;
f6195129	368
f6195129	369	if ( my $comment = $field->comments ) {
b89d5635	370	$comment =~ s/'/''/g;
f6195129	371	push @field_comments,
b89d5635	372	"COMMENT ON COLUMN $table_name_ur.$field_name_ur is\n '" .
e56dabb7	373	$comment . "';" unless $options->{no_comments};
f6195129	374	}
57f77285	375	}
	376
	377	#
02c2af3b	378	# Table options
	379	#
	380	my @table_options;
	381	for my $opt ( $table->options ) {
	382	if ( ref $opt eq 'HASH' ) {
	383	my ( $key, $value ) = each %$opt;
	384	if ( ref $value eq 'ARRAY' ) {
	385	push @table_options, "$key\n(\n". join ("\n",
	386	map { " $_->[0]\t$_->[1]" }
	387	map { [ each %$_ ] }
	388	@$value
	389	)."\n)";
	390	}
	391	elsif ( !defined $value ) {
	392	push @table_options, $key;
	393	}
	394	else {
	395	push @table_options, "$key $value";
	396	}
	397	}
	398	}
	399
	400	#
57f77285	401	# Table constraints
57f77285	402	#
57f77285	403	for my $c ( $table->get_constraints ) {
	404	my $name = $c->name \|\| '';
	405	my @fields = map { unreserve( $_, $table_name ) } $c->fields;
	406	my @rfields = map { unreserve( $_, $table_name ) }
	407	$c->reference_fields;
4dfb0380	408	next if !@fields && $c->type ne CHECK_C;
57f77285	409
57f77285	410	if ( $c->type eq PRIMARY_KEY ) {
54e61f1f	411	#$name \|\|= mk_name( $table_name, 'pk' );
	412	push @constraint_defs, ($name ? "CONSTRAINT $name " : '') .
	413	'PRIMARY KEY (' . join( ', ', @fields ) . ')';
57f77285	414	}
57f77285	415	elsif ( $c->type eq UNIQUE ) {
54e61f1f	416	# Don't create UNIQUE constraints identical to the primary key
	417	if ( my $pk = $table->primary_key ) {
	418	my $u_fields = join(":", @fields);
	419	my $pk_fields = join(":", $pk->fields);
	420	next if $u_fields eq $pk_fields;
	421	}
	422
	423	$name \|\|= mk_name( $name \|\| $table_name, 'u' );
6d4ce9b6	424
b0c196d4	425	for my $f ( $c->fields ) {
	426	my $field_def = $table->get_field( $f ) or next;
	427	my $dtype = $translate{ $field_def->data_type } or next;
	428	if ( $WARN && $dtype =~ /clob/i ) {
	429	warn "Oracle will not allow UNIQUE constraints on " .
	430	"CLOB field '" . $field_def->table->name . '.' .
	431	$field_def->name . ".'\n"
	432	}
	433	}
6d4ce9b6	434
57f77285	435	push @constraint_defs, "CONSTRAINT $name UNIQUE " .
	436	'(' . join( ', ', @fields ) . ')';
	437	}
4dfb0380	438	elsif ( $c->type eq CHECK_C ) {
54e61f1f	439	$name \|\|= mk_name( $name \|\| $table_name, 'ck' );
4dfb0380	440	my $expression = $c->expression \|\| '';
	441	push @constraint_defs, "CONSTRAINT $name CHECK ($expression)";
	442	}
57f77285	443	elsif ( $c->type eq FOREIGN_KEY ) {
e56dabb7	444	$name = mk_name( join('_', $table_name, $c->fields). '_fk' );
cd617ba8	445	my $def = "CONSTRAINT $name FOREIGN KEY ";
	446
	447	if ( @fields ) {
1c899510	448	$def .= '(' . join( ', ', @fields ) . ')';
cd617ba8	449	}
cd617ba8	450
1c899510	451	my $ref_table = unreserve($c->reference_table);
	452
	453	$def .= " REFERENCES $ref_table";
57f77285	454
	455	if ( @rfields ) {
	456	$def .= ' (' . join( ', ', @rfields ) . ')';
	457	}
	458
	459	if ( $c->match_type ) {
	460	$def .= ' MATCH ' .
	461	( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
	462	}
	463
	464	if ( $c->on_delete ) {
	465	$def .= ' ON DELETE '.join( ' ', $c->on_delete );
	466	}
	467
e56dabb7	468	# disabled by plu 2007-12-29 - doesn't exist for oracle
	469	#if ( $c->on_update ) {
	470	# $def .= ' ON UPDATE '.join( ' ', $c->on_update );
	471	#}
57f77285	472
e56dabb7	473	push @fk_defs, sprintf("ALTER TABLE %s ADD %s;", $table, $def);
57f77285	474	}
16dc9970	475	}
	476
	477	#
	478	# Index Declarations
	479	#
57f77285	480	my @index_defs = ();
57f77285	481	for my $index ( $table->get_indices ) {
	482	my $index_name = $index->name \|\| '';
	483	my $index_type = $index->type \|\| NORMAL;
44fcd0b5	484	my @fields = map { unreserve( $_, $table_name ) }
57f77285	485	$index->fields;
44fcd0b5	486	next unless @fields;
16dc9970	487
bdd8e79a	488	my @index_options;
	489	for my $opt ( $index->options ) {
	490	if ( ref $opt eq 'HASH' ) {
	491	my ( $key, $value ) = each %$opt;
	492	if ( ref $value eq 'ARRAY' ) {
	493	push @table_options, "$key\n(\n". join ("\n",
	494	map { " $_->[0]\t$_->[1]" }
	495	map { [ each %$_ ] }
	496	@$value
	497	)."\n)";
	498	}
	499	elsif ( !defined $value ) {
	500	push @index_options, $key;
	501	}
	502	else {
	503	push @index_options, "$key $value";
	504	}
	505	}
	506	}
	507	my $index_options = @index_options
	508	? "\n".join("\n", @index_options) : '';
	509
57f77285	510	if ( $index_type eq PRIMARY_KEY ) {
6d4ce9b6	511	$index_name = $index_name ? mk_name( $index_name )
6d4ce9b6	512	: mk_name( $table_name, 'pk' );
57f77285	513	push @field_defs, 'CONSTRAINT '.$index_name.' PRIMARY KEY '.
16dc9970	514	'(' . join( ', ', @fields ) . ')';
16dc9970	515	}
57f77285	516	elsif ( $index_type eq NORMAL ) {
6d4ce9b6	517	$index_name = $index_name ? mk_name( $index_name )
6d4ce9b6	518	: mk_name( $table_name, $index_name \|\| 'i' );
57f77285	519	push @index_defs,
da8e499e	520	"CREATE INDEX $index_name on $table_name_ur (".
da8e499e	521	join( ', ', @fields ).
bdd8e79a	522	")$index_options;";
16dc9970	523	}
041e659f	524	elsif ( $index_type eq UNIQUE ) {
	525	$index_name = $index_name ? mk_name( $index_name )
	526	: mk_name( $table_name, $index_name \|\| 'i' );
	527	push @index_defs,
	528	"CREATE UNIQUE INDEX $index_name on $table_name_ur (".
	529	join( ', ', @fields ).
bdd8e79a	530	")$index_options;";
041e659f	531	}
16dc9970	532	else {
96844cae	533	warn "Unknown index type ($index_type) on table $table_name.\n"
96844cae	534	if $WARN;
16dc9970	535	}
	536	}
	537
9fc9bfb1	538	if ( my @table_comments = $table->comments ) {
	539	for my $comment ( @table_comments ) {
	540	next unless $comment;
b89d5635	541	$comment =~ s/'/''/g;
b89d5635	542	push @field_comments, "COMMENT ON TABLE $table_name_ur is\n '".
e56dabb7	543	$comment . "';" unless $options->{no_comments}
9fc9bfb1	544	;
	545	}
	546	}
	547
02c2af3b	548	my $table_options = @table_options
02c2af3b	549	? "\n".join("\n", @table_options) : '';
e56dabb7	550	push @create, "CREATE TABLE $table_name_ur (\n" .
65ffb46c	551	join( ",\n", map { " $_" } @field_defs,
	552	($options->{delay_constraints} ? () : @constraint_defs) ) .
	553	"\n)$table_options;";
	554
	555	@constraint_defs = map { 'ALTER TABLE '.$table_name_ur.' ADD '.$_ }
	556	@constraint_defs;
16dc9970	557
96844cae	558	if ( $WARN ) {
	559	if ( %truncated ) {
	560	warn "Truncated " . keys( %truncated ) . " names:\n";
	561	warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
	562	}
	563
	564	if ( %unreserve ) {
	565	warn "Encounted " . keys( %unreserve ) .
	566	" unsafe names in schema (reserved or invalid):\n";
	567	warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
	568	}
	569	}
	570
65ffb46c	571	return \@create, \@fk_defs, \@trigger_defs, \@index_defs, ($options->{delay_constraints} ? \@constraint_defs : []);
e56dabb7	572	}
	573
	574	sub create_view {
	575	my ($view) = @_;
	576
	577	my $out = sprintf("CREATE VIEW %s AS\n%s;",
	578	$view->name,
	579	$view->sql);
	580
	581	return $out;
16dc9970	582	}
16dc9970	583
d529894e	584	# -------------------------------------------------------------------
d529894e	585	sub mk_name {
57f77285	586	my $basename = shift \|\| '';
57f77285	587	my $type = shift \|\| '';
1c899510	588	$type = '' if $type =~ /^\d/;
57f77285	589	my $scope = shift \|\| '';
57f77285	590	my $critical = shift \|\| '';
d529894e	591	my $basename_orig = $basename;
f5087552	592	my $max_name = $type
	593	? $max_id_length - (length($type) + 1)
	594	: $max_id_length;
96844cae	595	$basename = substr( $basename, 0, $max_name )
96844cae	596	if length( $basename ) > $max_name;
d529894e	597	my $name = $type ? "${type}_$basename" : $basename;
	598
	599	if ( $basename ne $basename_orig and $critical ) {
	600	my $show_type = $type ? "+'$type'" : "";
	601	warn "Truncating '$basename_orig'$show_type to $max_id_length ",
96844cae	602	"character limit to make '$name'\n" if $WARN;
96844cae	603	$truncated{ $basename_orig } = $name;
d529894e	604	}
	605
	606	$scope \|\|= \%global_names;
96844cae	607	if ( my $prev = $scope->{ $name } ) {
96844cae	608	my $name_orig = $name;
b89d5635	609	substr($name, $max_id_length - 2) = ""
	610	if length( $name ) >= $max_id_length - 1;
	611	$name .= sprintf( "%02d", $prev++ );
96844cae	612
	613	warn "The name '$name_orig' has been changed to ",
	614	"'$name' to make it unique.\n" if $WARN;
	615
	616	$scope->{ $name_orig }++;
	617	}
	618
	619	$scope->{ $name }++;
d529894e	620	return $name;
	621	}
	622
	623	# -------------------------------------------------------------------
	624	sub unreserve {
57f77285	625	my $name = shift \|\| '';
	626	my $schema_obj_name = shift \|\| '';
	627
96844cae	628	my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
d529894e	629
d529894e	630	# also trap fields that don't begin with a letter
57f77285	631	return $name if !$ora_reserved{ uc $name } && $name =~ /^[a-z]/i;
d529894e	632
	633	if ( $schema_obj_name ) {
	634	++$unreserve{"$schema_obj_name.$name"};
	635	}
	636	else {
	637	++$unreserve{"$name (table name)"};
	638	}
	639
	640	my $unreserve = sprintf '%s_', $name;
	641	return $unreserve.$suffix;
	642	}
	643
16dc9970	644	1;
16dc9970	645
d529894e	646	# -------------------------------------------------------------------
16dc9970	647	# All bad art is the result of good intentions.
16dc9970	648	# Oscar Wilde
d529894e	649	# -------------------------------------------------------------------
16dc9970	650
ba096dc4	651	=pod
16dc9970	652
d529894e	653	=head1 CREDITS
d529894e	654
ba096dc4	655	Mad props to Tim Bunce for much of the logic stolen from his "mysql2ora"
ba096dc4	656	script.
16dc9970	657
	658	=head1 AUTHOR
	659
ba096dc4	660	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
16dc9970	661
	662	=head1 SEE ALSO
	663
ba096dc4	664	SQL::Translator, DDL::Oracle, mysql2ora.
16dc9970	665
16dc9970	666	=cut