1 package SQL::Translator::Producer::Oracle;
3 # -------------------------------------------------------------------
4 # $Id: Oracle.pm,v 1.17 2003-08-15 16:26:44 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.17 $ =~ /(\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',
68 'double precision' => 'number',
70 bigserial => 'number',
73 'character varying' => 'varchar2',
86 macaddr => 'varchar2',
88 'bit varying' => 'number',
92 # Oracle reserved words from:
93 # http://technet.oracle.com/docs/products/oracle8i/doc_library/\
94 # 817_doc/server.817/a85397/ap_keywd.htm
96 my %ora_reserved = map { $_, 1 } qw(
97 ACCESS ADD ALL ALTER AND ANY AS ASC AUDIT
99 CHAR CHECK CLUSTER COLUMN COMMENT COMPRESS CONNECT CREATE CURRENT
100 DATE DECIMAL DEFAULT DELETE DESC DISTINCT DROP
101 ELSE EXCLUSIVE EXISTS
105 IDENTIFIED IMMEDIATE IN INCREMENT INDEX INITIAL INSERT
106 INTEGER INTERSECT INTO IS
108 MAXEXTENTS MINUS MLSLABEL MODE MODIFY
109 NOAUDIT NOCOMPRESS NOT NOWAIT NULL NUMBER
110 OF OFFLINE ON ONLINE OPTION OR ORDER
111 PCTFREE PRIOR PRIVILEGES PUBLIC
112 RAW RENAME RESOURCE REVOKE ROW ROWID ROWNUM ROWS
113 SELECT SESSION SET SHARE SIZE SMALLINT START
114 SUCCESSFUL SYNONYM SYSDATE
115 TABLE THEN TO TRIGGER
116 UID UNION UNIQUE UPDATE USER
117 VALIDATE VALUES VARCHAR VARCHAR2 VIEW
121 my $max_id_length = 30;
122 my %used_identifiers = ();
127 # -------------------------------------------------------------------
129 my $translator = shift;
130 $DEBUG = $translator->debug;
131 $WARN = $translator->show_warnings;
132 my $no_comments = $translator->no_comments;
133 my $add_drop_table = $translator->add_drop_table;
134 my $schema = $translator->schema;
137 $output .= header_comment unless ($no_comments);
139 if ( $translator->parser_type =~ /mysql/i ) {
141 "-- We assume that default NLS_DATE_FORMAT has been changed\n".
142 "-- but we set it here anyway to be self-consistent.\n".
143 "ALTER SESSION SET NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS';\n\n";
147 # Print create for each table
149 for my $table ( $schema->get_tables ) {
150 my $table_name = $table->name or next;
151 $table_name = mk_name( $table_name, '', undef, 1 );
152 my $table_name_ur = unreserve($table_name) or next;
154 my ( @comments, @field_defs, @trigger_defs, @constraint_defs );
156 push @comments, "--\n-- Table: $table_name_ur\n--" unless $no_comments;
158 my ( %field_name_scope, @field_comments );
159 for my $field ( $table->get_fields ) {
163 my $field_name = mk_name(
164 $field->name, '', \%field_name_scope, 1
166 my $field_name_ur = unreserve( $field_name, $table_name );
167 my $field_def = $field_name_ur;
173 my $data_type = lc $field->data_type;
174 my @size = $field->size;
175 my %extra = $field->extra;
176 my $list = $extra{'list'} || [];
177 my $commalist = join ",", @$list;
179 if ( $data_type eq 'enum' ) {
180 $check = "CHECK ($field_name IN ($commalist))";
181 $data_type = 'varchar2';
183 elsif ( $data_type eq 'set' ) {
184 # XXX add a CHECK constraint maybe
185 # (trickier and slower, than enum :)
186 $data_type = 'varchar2';
189 $data_type = defined $translate{ $data_type } ?
190 $translate{ $data_type } :
191 die "Unknown datatype: $data_type\n";
194 $field_def .= " $data_type";
195 if ( defined $size[0] && $size[0] > 0 ) {
196 $field_def .= '(' . join( ', ', @size ) . ')';
202 my $default = $field->default_value;
203 if ( defined $default ) {
204 $field_def .= sprintf(
206 $default =~ m/null/i ? 'NULL' : "'$default'"
211 # Not null constraint
213 unless ( $field->is_nullable ) {
214 my $constraint_name = mk_name($field_name_ur, 'nn');
215 $field_def .= ' CONSTRAINT ' . $constraint_name . ' NOT NULL';
218 $field_def .= " $check" if $check;
223 if ( $field->is_auto_increment ) {
224 my $base_name = $table_name . "_". $field_name;
225 my $seq_name = mk_name( $base_name, 'sq' );
226 my $trigger_name = mk_name( $base_name, 'ai' );
229 "CREATE SEQUENCE $seq_name;\n" .
230 "CREATE OR REPLACE TRIGGER $trigger_name\n" .
231 "BEFORE INSERT ON $table_name\n" .
232 "FOR EACH ROW WHEN (\n" .
233 " new.$field_name_ur IS NULL".
234 " OR new.$field_name_ur = 0\n".
237 " SELECT $seq_name.nextval\n" .
238 " INTO :new." . $field->name."\n" .
244 if ( lc $field->data_type eq 'timestamp' ) {
245 my $base_name = $table_name . "_". $field_name_ur;
246 my $trig_name = mk_name( $base_name, 'ts' );
248 "CREATE OR REPLACE TRIGGER $trig_name\n".
249 "BEFORE INSERT OR UPDATE ON $table_name_ur\n".
250 "FOR EACH ROW WHEN (new.$field_name_ur IS NULL)\n".
252 " SELECT sysdate INTO :new.$field_name_ur FROM dual;\n".
256 push @field_defs, $field_def;
258 if ( my $comment = $field->comments ) {
259 push @field_comments,
260 "COMMENT ON COLUMN $table_name.$field_name_ur is\n '".
268 my $constraint_name_default;
269 for my $c ( $table->get_constraints ) {
270 my $name = $c->name || '';
271 my @fields = map { unreserve( $_, $table_name ) } $c->fields;
272 my @rfields = map { unreserve( $_, $table_name ) }
273 $c->reference_fields;
276 if ( $c->type eq PRIMARY_KEY ) {
277 $name ||= mk_name( $table_name, 'pk' );
278 push @constraint_defs, "CONSTRAINT $name PRIMARY KEY ".
279 '(' . join( ', ', @fields ) . ')';
281 elsif ( $c->type eq UNIQUE ) {
282 $name ||= mk_name( $table_name, ++$constraint_name_default );
283 push @constraint_defs, "CONSTRAINT $name UNIQUE " .
284 '(' . join( ', ', @fields ) . ')';
286 elsif ( $c->type eq FOREIGN_KEY ) {
287 $name ||= mk_name( $table_name, ++$constraint_name_default );
288 my $def = "CONSTRAINT $name FOREIGN KEY ";
291 $def .= join( ', ', @fields );
294 $def .= ' REFERENCES ' . $c->reference_table;
297 $def .= ' (' . join( ', ', @rfields ) . ')';
300 if ( $c->match_type ) {
302 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
305 if ( $c->on_delete ) {
306 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
309 if ( $c->on_update ) {
310 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
313 push @constraint_defs, $def;
321 my $idx_name_default;
322 for my $index ( $table->get_indices ) {
323 my $index_name = $index->name || '';
324 my $index_type = $index->type || NORMAL;
325 my @fields = map { unreserve( $_, $table_name ) }
329 if ( $index_type eq PRIMARY_KEY ) {
330 $index_name = mk_name( $table_name, 'pk' );
331 push @field_defs, 'CONSTRAINT '.$index_name.' PRIMARY KEY '.
332 '(' . join( ', ', @fields ) . ')';
334 elsif ( $index_type eq UNIQUE ) {
335 $index_name = mk_name(
336 $table_name, $index_name || ++$idx_name_default
338 push @field_defs, 'CONSTRAINT ' . $index_name . ' UNIQUE ' .
339 '(' . join( ', ', @fields ) . ')';
342 elsif ( $index_type eq NORMAL ) {
343 $index_name = mk_name(
344 $table_name, $index_name || ++$idx_name_default
347 "CREATE INDEX $index_name on $table_name_ur (".
348 join( ', ', @fields ).
352 warn "Unknown index type ($index_type) on table $table_name.\n"
357 my $create_statement;
358 $create_statement = "DROP TABLE $table_name_ur;\n" if $add_drop_table;
360 join( ",\n", map { "-- $_" } $table->comments ) .
361 "CREATE TABLE $table_name_ur (\n" .
362 join( ",\n", map { " $_" } @field_defs, @constraint_defs ) .
366 $output .= join( "\n\n",
378 warn "Truncated " . keys( %truncated ) . " names:\n";
379 warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
383 warn "Encounted " . keys( %unreserve ) .
384 " unsafe names in schema (reserved or invalid):\n";
385 warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
392 # -------------------------------------------------------------------
394 my $basename = shift || '';
395 my $type = shift || '';
396 my $scope = shift || '';
397 my $critical = shift || '';
398 my $basename_orig = $basename;
400 ? $max_id_length - (length($type) + 1)
402 $basename = substr( $basename, 0, $max_name )
403 if length( $basename ) > $max_name;
404 my $name = $type ? "${type}_$basename" : $basename;
406 if ( $basename ne $basename_orig and $critical ) {
407 my $show_type = $type ? "+'$type'" : "";
408 warn "Truncating '$basename_orig'$show_type to $max_id_length ",
409 "character limit to make '$name'\n" if $WARN;
410 $truncated{ $basename_orig } = $name;
413 $scope ||= \%global_names;
414 if ( my $prev = $scope->{ $name } ) {
415 my $name_orig = $name;
416 $name .= sprintf( "%02d", ++$prev );
417 substr($name, $max_id_length - 3) = "00"
418 if length( $name ) > $max_id_length;
420 warn "The name '$name_orig' has been changed to ",
421 "'$name' to make it unique.\n" if $WARN;
423 $scope->{ $name_orig }++;
430 # -------------------------------------------------------------------
432 my $name = shift || '';
433 my $schema_obj_name = shift || '';
435 my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
437 # also trap fields that don't begin with a letter
438 return $name if !$ora_reserved{ uc $name } && $name =~ /^[a-z]/i;
440 if ( $schema_obj_name ) {
441 ++$unreserve{"$schema_obj_name.$name"};
444 ++$unreserve{"$name (table name)"};
447 my $unreserve = sprintf '%s_', $name;
448 return $unreserve.$suffix;
453 # -------------------------------------------------------------------
454 # All bad art is the result of good intentions.
456 # -------------------------------------------------------------------
460 SQL::Translator::Producer::Oracle - Oracle SQL producer
464 use SQL::Translator::Parser::MySQL;
465 use SQL::Translator::Producer::Oracle;
467 my $original_create = ""; # get this from somewhere...
468 my $translator = SQL::Translator->new;
470 $translator->parser("SQL::Translator::Parser::MySQL");
471 $translator->producer("SQL::Translator::Producer::Oracle");
473 my $new_create = $translator->translate($original_create);
477 SQL::Translator::Producer::Oracle takes a parsed data structure,
478 created by a SQL::Translator::Parser subclass, and turns it into a
479 create string suitable for use with an Oracle database.
483 A hearty "thank-you" to Tim Bunce for much of the logic stolen from
484 his "mysql2ora" script.
488 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>