1 package SQL::Translator::Producer::Oracle;
3 # -------------------------------------------------------------------
4 # $Id: Oracle.pm,v 1.15 2003-08-04 21:04:04 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.15 $ =~ /(\d+)\.(\d+)/;
28 $DEBUG = 0 unless defined $DEBUG;
30 use SQL::Translator::Schema::Constants;
31 use SQL::Translator::Utils qw(header_comment);
42 mediumint => 'number',
46 varchar => 'varchar2',
67 'double precision' => 'number',
69 bigserial => 'number',
72 'character varying' => 'varchar2',
85 macaddr => 'varchar2',
87 'bit varying' => 'number',
91 # Oracle reserved words from:
92 # http://technet.oracle.com/docs/products/oracle8i/doc_library/\
93 # 817_doc/server.817/a85397/ap_keywd.htm
95 my %ora_reserved = map { $_, 1 } qw(
96 ACCESS ADD ALL ALTER AND ANY AS ASC AUDIT
98 CHAR CHECK CLUSTER COLUMN COMMENT COMPRESS CONNECT CREATE CURRENT
99 DATE DECIMAL DEFAULT DELETE DESC DISTINCT DROP
100 ELSE EXCLUSIVE EXISTS
104 IDENTIFIED IMMEDIATE IN INCREMENT INDEX INITIAL INSERT
105 INTEGER INTERSECT INTO IS
107 MAXEXTENTS MINUS MLSLABEL MODE MODIFY
108 NOAUDIT NOCOMPRESS NOT NOWAIT NULL NUMBER
109 OF OFFLINE ON ONLINE OPTION OR ORDER
110 PCTFREE PRIOR PRIVILEGES PUBLIC
111 RAW RENAME RESOURCE REVOKE ROW ROWID ROWNUM ROWS
112 SELECT SESSION SET SHARE SIZE SMALLINT START
113 SUCCESSFUL SYNONYM SYSDATE
114 TABLE THEN TO TRIGGER
115 UID UNION UNIQUE UPDATE USER
116 VALIDATE VALUES VARCHAR VARCHAR2 VIEW
120 my $max_id_length = 30;
121 my %used_identifiers = ();
126 # -------------------------------------------------------------------
128 my $translator = shift;
129 $DEBUG = $translator->debug;
130 $WARN = $translator->show_warnings;
131 my $no_comments = $translator->no_comments;
132 my $add_drop_table = $translator->add_drop_table;
133 my $schema = $translator->schema;
136 $output .= header_comment unless ($no_comments);
138 if ( $translator->parser_type =~ /mysql/i ) {
140 "-- We assume that default NLS_DATE_FORMAT has been changed\n".
141 "-- but we set it here anyway to be self-consistent.\n".
142 "ALTER SESSION SET NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS';\n\n";
146 # Print create for each table
148 for my $table ( $schema->get_tables ) {
149 my $table_name = $table->name or next;
150 $table_name = mk_name( $table_name, '', undef, 1 );
151 my $table_name_ur = unreserve($table_name) or next;
153 my ( @comments, @field_defs, @trigger_defs, @constraint_defs );
155 push @comments, "--\n-- Table: $table_name_ur\n--" unless $no_comments;
157 my ( %field_name_scope, @field_comments );
158 for my $field ( $table->get_fields ) {
162 my $field_name = mk_name(
163 $field->name, '', \%field_name_scope, 1
165 my $field_name_ur = unreserve( $field_name, $table_name );
166 my $field_def = $field_name_ur;
172 my $data_type = lc $field->data_type;
173 my @size = $field->size;
174 my %extra = $field->extra;
175 my $list = $extra{'list'} || [];
176 my $commalist = join ",", @$list;
178 if ( $data_type eq 'enum' ) {
179 $check = "CHECK ($field_name IN ($commalist))";
180 $data_type = 'varchar2';
182 elsif ( $data_type eq 'set' ) {
183 # XXX add a CHECK constraint maybe
184 # (trickier and slower, than enum :)
185 $data_type = 'varchar2';
188 $data_type = defined $translate{ $data_type } ?
189 $translate{ $data_type } :
190 die "Unknown datatype: $data_type\n";
193 $field_def .= " $data_type";
194 if ( defined $size[0] && $size[0] > 0 ) {
195 $field_def .= '(' . join( ', ', @size ) . ')';
201 my $default = $field->default_value;
202 if ( defined $default ) {
203 $field_def .= sprintf(
205 $default =~ m/null/i ? 'NULL' : "'$default'"
210 # Not null constraint
212 unless ( $field->is_nullable ) {
213 my $constraint_name = mk_name($field_name_ur, 'nn');
214 $field_def .= ' CONSTRAINT ' . $constraint_name . ' NOT NULL';
217 $field_def .= " $check" if $check;
222 if ( $field->is_auto_increment ) {
223 my $base_name = $table_name . "_". $field_name;
224 my $seq_name = mk_name( $base_name, 'sq' );
225 my $trigger_name = mk_name( $base_name, 'ai' );
228 "CREATE SEQUENCE $seq_name;\n" .
229 "CREATE OR REPLACE TRIGGER $trigger_name\n" .
230 "BEFORE INSERT ON $table_name\n" .
231 "FOR EACH ROW WHEN (\n" .
232 " new.$field_name_ur IS NULL".
233 " OR new.$field_name_ur = 0\n".
236 " SELECT $seq_name.nextval\n" .
237 " INTO :new." . $field->name."\n" .
243 if ( lc $field->data_type eq 'timestamp' ) {
244 my $base_name = $table_name . "_". $field_name_ur;
245 my $trig_name = mk_name( $base_name, 'ts' );
247 "CREATE OR REPLACE TRIGGER $trig_name\n".
248 "BEFORE INSERT OR UPDATE ON $table_name_ur\n".
249 "FOR EACH ROW WHEN (new.$field_name_ur} IS NULL)\n".
251 " SELECT sysdate INTO :new.$field_name_ur} FROM dual;\n".
255 push @field_defs, $field_def;
257 if ( my $comment = $field->comments ) {
258 push @field_comments,
259 "COMMENT ON COLUMN $table_name.$field_name_ur is\n '".
267 my $constraint_name_default;
268 for my $c ( $table->get_constraints ) {
269 my $name = $c->name || '';
270 my @fields = map { unreserve( $_, $table_name ) } $c->fields;
271 my @rfields = map { unreserve( $_, $table_name ) }
272 $c->reference_fields;
275 if ( $c->type eq PRIMARY_KEY ) {
276 $name ||= mk_name( $table_name, 'pk' );
277 push @constraint_defs, "CONSTRAINT $name PRIMARY KEY ".
278 '(' . join( ', ', @fields ) . ')';
280 elsif ( $c->type eq UNIQUE ) {
281 $name ||= mk_name( $table_name, ++$constraint_name_default );
282 push @constraint_defs, "CONSTRAINT $name UNIQUE " .
283 '(' . join( ', ', @fields ) . ')';
285 elsif ( $c->type eq FOREIGN_KEY ) {
286 $name ||= mk_name( $table_name, ++$constraint_name_default );
287 my $def = "CONSTRAINT $name FOREIGN KEY ";
290 $def .= join( ', ', @fields );
293 $def .= ' REFERENCES ' . $c->reference_table;
296 $def .= ' (' . join( ', ', @rfields ) . ')';
299 if ( $c->match_type ) {
301 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
304 if ( $c->on_delete ) {
305 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
308 if ( $c->on_update ) {
309 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
312 push @constraint_defs, $def;
320 my $idx_name_default;
321 for my $index ( $table->get_indices ) {
322 my $index_name = $index->name || '';
323 my $index_type = $index->type || NORMAL;
324 my @fields = map { unreserve( $_, $table_name ) }
328 if ( $index_type eq PRIMARY_KEY ) {
329 $index_name = mk_name( $table_name, 'pk' );
330 push @field_defs, 'CONSTRAINT '.$index_name.' PRIMARY KEY '.
331 '(' . join( ', ', @fields ) . ')';
333 elsif ( $index_type eq UNIQUE ) {
334 $index_name = mk_name(
335 $table_name, $index_name || ++$idx_name_default
337 push @field_defs, 'CONSTRAINT ' . $index_name . ' UNIQUE ' .
338 '(' . join( ', ', @fields ) . ')';
341 elsif ( $index_type eq NORMAL ) {
342 $index_name = mk_name(
343 $table_name, $index_name || ++$idx_name_default
346 "CREATE INDEX $index_name on $table_name_ur (".
347 join( ', ', @fields ).
351 warn "Unknown index type ($index_type) on table $table_name.\n"
356 my $create_statement;
357 $create_statement = "DROP TABLE $table_name_ur;\n" if $add_drop_table;
359 join( ",\n", map { "-- $_" } $table->comments ) .
360 "CREATE TABLE $table_name_ur (\n" .
361 join( ",\n", map { " $_" } @field_defs, @constraint_defs ) .
365 $output .= join( "\n\n",
377 warn "Truncated " . keys( %truncated ) . " names:\n";
378 warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
382 warn "Encounted " . keys( %unreserve ) .
383 " unsafe names in schema (reserved or invalid):\n";
384 warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
391 # -------------------------------------------------------------------
393 my $basename = shift || '';
394 my $type = shift || '';
395 my $scope = shift || '';
396 my $critical = shift || '';
397 my $basename_orig = $basename;
399 ? $max_id_length - (length($type) + 1)
401 $basename = substr( $basename, 0, $max_name )
402 if length( $basename ) > $max_name;
403 my $name = $type ? "${type}_$basename" : $basename;
405 if ( $basename ne $basename_orig and $critical ) {
406 my $show_type = $type ? "+'$type'" : "";
407 warn "Truncating '$basename_orig'$show_type to $max_id_length ",
408 "character limit to make '$name'\n" if $WARN;
409 $truncated{ $basename_orig } = $name;
412 $scope ||= \%global_names;
413 if ( my $prev = $scope->{ $name } ) {
414 my $name_orig = $name;
415 $name .= sprintf( "%02d", ++$prev );
416 substr($name, $max_id_length - 3) = "00"
417 if length( $name ) > $max_id_length;
419 warn "The name '$name_orig' has been changed to ",
420 "'$name' to make it unique.\n" if $WARN;
422 $scope->{ $name_orig }++;
429 # -------------------------------------------------------------------
431 my $name = shift || '';
432 my $schema_obj_name = shift || '';
434 my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
436 # also trap fields that don't begin with a letter
437 return $name if !$ora_reserved{ uc $name } && $name =~ /^[a-z]/i;
439 if ( $schema_obj_name ) {
440 ++$unreserve{"$schema_obj_name.$name"};
443 ++$unreserve{"$name (table name)"};
446 my $unreserve = sprintf '%s_', $name;
447 return $unreserve.$suffix;
452 # -------------------------------------------------------------------
453 # All bad art is the result of good intentions.
455 # -------------------------------------------------------------------
459 SQL::Translator::Producer::Oracle - Oracle SQL producer
463 use SQL::Translator::Parser::MySQL;
464 use SQL::Translator::Producer::Oracle;
466 my $original_create = ""; # get this from somewhere...
467 my $translator = SQL::Translator->new;
469 $translator->parser("SQL::Translator::Parser::MySQL");
470 $translator->producer("SQL::Translator::Producer::Oracle");
472 my $new_create = $translator->translate($original_create);
476 SQL::Translator::Producer::Oracle takes a parsed data structure,
477 created by a SQL::Translator::Parser subclass, and turns it into a
478 create string suitable for use with an Oracle database.
482 A hearty "thank-you" to Tim Bunce for much of the logic stolen from
483 his "mysql2ora" script.
487 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>