1 package SQL::Translator::Producer::Oracle;
3 # -------------------------------------------------------------------
4 # $Id: Oracle.pm,v 1.24 2003-08-27 02:28:21 kycl4rk Exp $
5 # -------------------------------------------------------------------
6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
7 # darren chamberlain <darren@cpan.org>,
8 # Chris Mungall <cjm@fruitfly.org>
10 # This program is free software; you can redistribute it and/or
11 # modify it under the terms of the GNU General Public License as
12 # published by the Free Software Foundation; version 2.
14 # This program is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 # General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with this program; if not, write to the Free Software
21 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
23 # -------------------------------------------------------------------
26 use vars qw[ $VERSION $DEBUG $WARN ];
27 $VERSION = sprintf "%d.%02d", q$Revision: 1.24 $ =~ /(\d+)\.(\d+)/;
28 $DEBUG = 0 unless defined $DEBUG;
30 use SQL::Translator::Schema::Constants;
31 use SQL::Translator::Utils qw(header_comment);
43 mediumint => 'number',
47 varchar => 'varchar2',
52 tinytext => 'varchar2',
68 'double precision' => 'number',
70 bigserial => 'number',
73 'character varying' => 'varchar2',
86 macaddr => 'varchar2',
88 'bit varying' => 'number',
94 varchar2 => 'varchar2',
99 # Oracle reserved words from:
100 # http://technet.oracle.com/docs/products/oracle8i/doc_library/\
101 # 817_doc/server.817/a85397/ap_keywd.htm
103 my %ora_reserved = map { $_, 1 } qw(
104 ACCESS ADD ALL ALTER AND ANY AS ASC AUDIT
106 CHAR CHECK CLUSTER COLUMN COMMENT COMPRESS CONNECT CREATE CURRENT
107 DATE DECIMAL DEFAULT DELETE DESC DISTINCT DROP
108 ELSE EXCLUSIVE EXISTS
112 IDENTIFIED IMMEDIATE IN INCREMENT INDEX INITIAL INSERT
113 INTEGER INTERSECT INTO IS
115 MAXEXTENTS MINUS MLSLABEL MODE MODIFY
116 NOAUDIT NOCOMPRESS NOT NOWAIT NULL NUMBER
117 OF OFFLINE ON ONLINE OPTION OR ORDER
118 PCTFREE PRIOR PRIVILEGES PUBLIC
119 RAW RENAME RESOURCE REVOKE ROW ROWID ROWNUM ROWS
120 SELECT SESSION SET SHARE SIZE SMALLINT START
121 SUCCESSFUL SYNONYM SYSDATE
122 TABLE THEN TO TRIGGER
123 UID UNION UNIQUE UPDATE USER
124 VALIDATE VALUES VARCHAR VARCHAR2 VIEW
128 my $max_id_length = 30;
129 my %used_identifiers = ();
134 # -------------------------------------------------------------------
136 my $translator = shift;
137 $DEBUG = $translator->debug;
138 $WARN = $translator->show_warnings;
139 my $no_comments = $translator->no_comments;
140 my $add_drop_table = $translator->add_drop_table;
141 my $schema = $translator->schema;
144 $output .= header_comment unless ($no_comments);
146 if ( $translator->parser_type =~ /mysql/i ) {
148 "-- We assume that default NLS_DATE_FORMAT has been changed\n".
149 "-- but we set it here anyway to be self-consistent.\n".
150 "ALTER SESSION SET NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS';\n\n";
154 # Print create for each table
156 for my $table ( $schema->get_tables ) {
157 my $table_name = $table->name or next;
158 $table_name = mk_name( $table_name, '', undef, 1 );
159 my $table_name_ur = unreserve($table_name) or next;
161 my ( @comments, @field_defs, @trigger_defs, @constraint_defs );
163 push @comments, "--\n-- Table: $table_name_ur\n--" unless $no_comments;
165 my ( %field_name_scope, @field_comments );
166 for my $field ( $table->get_fields ) {
170 my $field_name = mk_name(
171 $field->name, '', \%field_name_scope, 1
173 my $field_name_ur = unreserve( $field_name, $table_name );
174 my $field_def = $field_name_ur;
180 my $data_type = lc $field->data_type;
181 my @size = $field->size;
182 my %extra = $field->extra;
183 my $list = $extra{'list'} || [];
184 # \todo deal with embedded quotes
185 my $commalist = join( ', ', map { qq['$_'] } @$list );
187 if ( $data_type eq 'enum' ) {
188 $check = "CHECK ($field_name_ur IN ($commalist))";
189 $data_type = 'varchar2';
191 elsif ( $data_type eq 'set' ) {
192 # XXX add a CHECK constraint maybe
193 # (trickier and slower, than enum :)
194 $data_type = 'varchar2';
197 $data_type = defined $translate{ $data_type } ?
198 $translate{ $data_type } :
199 die "Unknown datatype: $data_type\n";
203 # Fixes ORA-02329: column of datatype LOB cannot be
204 # unique or a primary key
206 if ( $data_type eq 'clob' && $field->is_primary_key ) {
207 $data_type = 'varchar2';
209 warn "CLOB cannot be a primary key, changing to VARCHAR2\n"
214 # Fixes ORA-00907: missing right parenthesis
216 if ( $data_type =~ /(date|clob)/i ) {
220 $field_def .= " $data_type";
221 if ( defined $size[0] && $size[0] > 0 ) {
222 $field_def .= '(' . join( ', ', @size ) . ')';
228 my $default = $field->default_value;
229 if ( defined $default ) {
231 # Wherein we try to catch a string being used as
232 # a default value for a numerical field. If "true/false,"
233 # then sub "1/0," otherwise just test the truthity of the
234 # argument and use that (naive?).
237 $data_type =~ /^number$/i &&
238 $default !~ /^\d+$/ &&
241 if ( $default =~ /^true$/i ) {
244 elsif ( $default =~ /^false$/i ) {
248 $default = $default ? "'1'" : "'0'";
252 $data_type =~ /date/ && $default eq 'current_timestamp'
254 $default = 'SYSDATE';
257 $default = $default =~ m/null/i ? 'NULL' : "'$default'"
260 $field_def .= " DEFAULT $default",
264 # Not null constraint
266 unless ( $field->is_nullable ) {
267 my $constraint_name = mk_name(
268 join('_', $table_name_ur, $field_name_ur ), 'nn'
270 $field_def .= ' CONSTRAINT ' . $constraint_name . ' NOT NULL';
273 $field_def .= " $check" if $check;
278 if ( $field->is_auto_increment ) {
279 my $base_name = $table_name . "_". $field_name;
280 my $seq_name = mk_name( $base_name, 'sq' );
281 my $trigger_name = mk_name( $base_name, 'ai' );
284 "CREATE SEQUENCE $seq_name;\n" .
285 "CREATE OR REPLACE TRIGGER $trigger_name\n" .
286 "BEFORE INSERT ON $table_name\n" .
287 "FOR EACH ROW WHEN (\n" .
288 " new.$field_name_ur IS NULL".
289 " OR new.$field_name_ur = 0\n".
292 " SELECT $seq_name.nextval\n" .
293 " INTO :new." . $field->name."\n" .
299 if ( lc $field->data_type eq 'timestamp' ) {
300 my $base_name = $table_name . "_". $field_name_ur;
301 my $trig_name = mk_name( $base_name, 'ts' );
303 "CREATE OR REPLACE TRIGGER $trig_name\n".
304 "BEFORE INSERT OR UPDATE ON $table_name_ur\n".
305 "FOR EACH ROW WHEN (new.$field_name_ur IS NULL)\n".
307 " SELECT sysdate INTO :new.$field_name_ur FROM dual;\n".
311 push @field_defs, $field_def;
313 if ( my $comment = $field->comments ) {
314 push @field_comments,
315 "COMMENT ON COLUMN $table_name.$field_name_ur is\n '".
323 for my $c ( $table->get_constraints ) {
324 my $name = $c->name || '';
325 my @fields = map { unreserve( $_, $table_name ) } $c->fields;
326 my @rfields = map { unreserve( $_, $table_name ) }
327 $c->reference_fields;
328 next if !@fields && $c->type ne CHECK_C;
330 if ( $c->type eq PRIMARY_KEY ) {
331 $name ||= mk_name( $table_name, 'pk' );
332 push @constraint_defs, "CONSTRAINT $name PRIMARY KEY ".
333 '(' . join( ', ', @fields ) . ')';
335 elsif ( $c->type eq UNIQUE ) {
336 $name ||= mk_name( $table_name, 'u' );
337 push @constraint_defs, "CONSTRAINT $name UNIQUE " .
338 '(' . join( ', ', @fields ) . ')';
340 elsif ( $c->type eq CHECK_C ) {
341 $name ||= mk_name( $table_name, 'ck' );
342 my $expression = $c->expression || '';
343 push @constraint_defs, "CONSTRAINT $name CHECK ($expression)";
345 elsif ( $c->type eq FOREIGN_KEY ) {
346 $name ||= mk_name( join('_', $table_name, $c->fields), 'fk' );
347 my $def = "CONSTRAINT $name FOREIGN KEY ";
350 $def .= '(' . join( ', ', @fields ) . ')';
353 my $ref_table = unreserve($c->reference_table);
355 $def .= " REFERENCES $ref_table";
358 $def .= ' (' . join( ', ', @rfields ) . ')';
361 if ( $c->match_type ) {
363 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
366 if ( $c->on_delete ) {
367 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
370 if ( $c->on_update ) {
371 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
374 push @constraint_defs, $def;
382 for my $index ( $table->get_indices ) {
383 my $index_name = $index->name || '';
384 my $index_type = $index->type || NORMAL;
385 my @fields = map { unreserve( $_, $table_name ) }
389 if ( $index_type eq PRIMARY_KEY ) {
390 $index_name ||= mk_name( $table_name, 'pk' );
391 push @field_defs, 'CONSTRAINT '.$index_name.' PRIMARY KEY '.
392 '(' . join( ', ', @fields ) . ')';
394 elsif ( $index_type eq NORMAL ) {
395 $index_name ||= mk_name( $table_name, $index_name || 'i' );
397 "CREATE INDEX $index_name on $table_name_ur (".
398 join( ', ', @fields ).
402 warn "Unknown index type ($index_type) on table $table_name.\n"
407 my $create_statement;
408 $create_statement = "DROP TABLE $table_name_ur;\n" if $add_drop_table;
410 if ( my @table_comments = $table->comments ) {
411 for my $comment ( @table_comments ) {
412 next unless $comment;
413 push @field_comments, "COMMENT ON TABLE $table_name is\n '".
419 $create_statement .= "CREATE TABLE $table_name_ur (\n" .
420 join( ",\n", map { " $_" } @field_defs, @constraint_defs ) .
424 $output .= join( "\n\n",
436 warn "Truncated " . keys( %truncated ) . " names:\n";
437 warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
441 warn "Encounted " . keys( %unreserve ) .
442 " unsafe names in schema (reserved or invalid):\n";
443 warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
450 # -------------------------------------------------------------------
452 my $basename = shift || '';
453 my $type = shift || '';
454 $type = '' if $type =~ /^\d/;
455 my $scope = shift || '';
456 my $critical = shift || '';
457 my $basename_orig = $basename;
459 ? $max_id_length - (length($type) + 1)
461 $basename = substr( $basename, 0, $max_name )
462 if length( $basename ) > $max_name;
463 my $name = $type ? "${type}_$basename" : $basename;
465 if ( $basename ne $basename_orig and $critical ) {
466 my $show_type = $type ? "+'$type'" : "";
467 warn "Truncating '$basename_orig'$show_type to $max_id_length ",
468 "character limit to make '$name'\n" if $WARN;
469 $truncated{ $basename_orig } = $name;
472 $scope ||= \%global_names;
473 if ( my $prev = $scope->{ $name } ) {
474 my $name_orig = $name;
475 $name .= sprintf( "%02d", ++$prev );
476 substr($name, $max_id_length - 3) = "00"
477 if length( $name ) > $max_id_length;
479 warn "The name '$name_orig' has been changed to ",
480 "'$name' to make it unique.\n" if $WARN;
482 $scope->{ $name_orig }++;
489 # -------------------------------------------------------------------
491 my $name = shift || '';
492 my $schema_obj_name = shift || '';
494 my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
496 # also trap fields that don't begin with a letter
497 return $name if !$ora_reserved{ uc $name } && $name =~ /^[a-z]/i;
499 if ( $schema_obj_name ) {
500 ++$unreserve{"$schema_obj_name.$name"};
503 ++$unreserve{"$name (table name)"};
506 my $unreserve = sprintf '%s_', $name;
507 return $unreserve.$suffix;
512 # -------------------------------------------------------------------
513 # All bad art is the result of good intentions.
515 # -------------------------------------------------------------------
519 SQL::Translator::Producer::Oracle - Oracle SQL producer
523 use SQL::Translator::Parser::MySQL;
524 use SQL::Translator::Producer::Oracle;
526 my $original_create = ""; # get this from somewhere...
527 my $translator = SQL::Translator->new;
529 $translator->parser("SQL::Translator::Parser::MySQL");
530 $translator->producer("SQL::Translator::Producer::Oracle");
532 my $new_create = $translator->translate($original_create);
536 SQL::Translator::Producer::Oracle takes a parsed data structure,
537 created by a SQL::Translator::Parser subclass, and turns it into a
538 create string suitable for use with an Oracle database.
542 A hearty "thank-you" to Tim Bunce for much of the logic stolen from
543 his "mysql2ora" script.
547 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>