Added quotes around ENUM values in CONSTRAINT for Oracle & Sybase.
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / Oracle.pm
CommitLineData
16dc9970 1package SQL::Translator::Producer::Oracle;
2
077ebf34 3# -------------------------------------------------------------------
77d74ea6 4# $Id: Oracle.pm,v 1.18 2003-08-17 01:11:54 rossta Exp $
077ebf34 5# -------------------------------------------------------------------
abfa405a 6# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
7# darren chamberlain <darren@cpan.org>,
8# Chris Mungall <cjm@fruitfly.org>
16dc9970 9#
077ebf34 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.
13#
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.
18#
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
22# 02111-1307 USA
23# -------------------------------------------------------------------
24
16dc9970 25use strict;
96844cae 26use vars qw[ $VERSION $DEBUG $WARN ];
77d74ea6 27$VERSION = sprintf "%d.%02d", q$Revision: 1.18 $ =~ /(\d+)\.(\d+)/;
d529894e 28$DEBUG = 0 unless defined $DEBUG;
16dc9970 29
57f77285 30use SQL::Translator::Schema::Constants;
5ee19df8 31use SQL::Translator::Utils qw(header_comment);
32
16dc9970 33my %translate = (
d529894e 34 #
35 # MySQL types
36 #
16dc9970 37 bigint => 'number',
38 double => 'number',
39 decimal => 'number',
40 float => 'number',
41 int => 'number',
25966689 42 integer => 'number',
16dc9970 43 mediumint => 'number',
44 smallint => 'number',
45 tinyint => 'number',
16dc9970 46 char => 'char',
16dc9970 47 varchar => 'varchar2',
16dc9970 48 tinyblob => 'CLOB',
49 blob => 'CLOB',
50 mediumblob => 'CLOB',
51 longblob => 'CLOB',
16dc9970 52 longtext => 'long',
53 mediumtext => 'long',
54 text => 'long',
55 tinytext => 'long',
16dc9970 56 enum => 'varchar2',
57 set => 'varchar2',
16dc9970 58 date => 'date',
59 datetime => 'date',
60 time => 'date',
61 timestamp => 'date',
62 year => 'date',
d529894e 63
64 #
65 # PostgreSQL types
66 #
57f77285 67 numeric => 'number',
68 'double precision' => 'number',
69 serial => 'number',
70 bigserial => 'number',
71 money => 'number',
72 character => 'char',
73 'character varying' => 'varchar2',
74 bytea => 'BLOB',
75 interval => 'number',
76 boolean => 'number',
77 point => 'number',
78 line => 'number',
79 lseg => 'number',
80 box => 'number',
81 path => 'number',
82 polygon => 'number',
83 circle => 'number',
84 cidr => 'number',
85 inet => 'varchar2',
86 macaddr => 'varchar2',
87 bit => 'number',
88 'bit varying' => 'number',
d529894e 89);
90
91#
92# Oracle reserved words from:
93# http://technet.oracle.com/docs/products/oracle8i/doc_library/\
94# 817_doc/server.817/a85397/ap_keywd.htm
95#
96844cae 96my %ora_reserved = map { $_, 1 } qw(
d529894e 97 ACCESS ADD ALL ALTER AND ANY AS ASC AUDIT
98 BETWEEN BY
99 CHAR CHECK CLUSTER COLUMN COMMENT COMPRESS CONNECT CREATE CURRENT
100 DATE DECIMAL DEFAULT DELETE DESC DISTINCT DROP
101 ELSE EXCLUSIVE EXISTS
102 FILE FLOAT FOR FROM
103 GRANT GROUP
104 HAVING
105 IDENTIFIED IMMEDIATE IN INCREMENT INDEX INITIAL INSERT
106 INTEGER INTERSECT INTO IS
107 LEVEL LIKE LOCK LONG
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
118 WHENEVER WHERE WITH
16dc9970 119);
120
96844cae 121my $max_id_length = 30;
122my %used_identifiers = ();
d529894e 123my %global_names;
124my %unreserve;
125my %truncated;
16dc9970 126
96844cae 127# -------------------------------------------------------------------
077ebf34 128sub produce {
a1d94525 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;
d529894e 135 my $output;
44fcd0b5 136
5ee19df8 137 $output .= header_comment unless ($no_comments);
077ebf34 138
d529894e 139 if ( $translator->parser_type =~ /mysql/i ) {
140 $output .=
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";
144 }
16dc9970 145
146 #
147 # Print create for each table
148 #
57f77285 149 for my $table ( $schema->get_tables ) {
150 my $table_name = $table->name or next;
44fcd0b5 151 $table_name = mk_name( $table_name, '', undef, 1 );
57f77285 152 my $table_name_ur = unreserve($table_name) or next;
16dc9970 153
57f77285 154 my ( @comments, @field_defs, @trigger_defs, @constraint_defs );
16dc9970 155
44fcd0b5 156 push @comments, "--\n-- Table: $table_name_ur\n--" unless $no_comments;
16dc9970 157
f6195129 158 my ( %field_name_scope, @field_comments );
57f77285 159 for my $field ( $table->get_fields ) {
16dc9970 160 #
161 # Field name
162 #
44fcd0b5 163 my $field_name = mk_name(
57f77285 164 $field->name, '', \%field_name_scope, 1
44fcd0b5 165 );
166 my $field_name_ur = unreserve( $field_name, $table_name );
57f77285 167 my $field_def = $field_name_ur;
16dc9970 168
169 #
170 # Datatype
171 #
44fcd0b5 172 my $check;
57f77285 173 my $data_type = lc $field->data_type;
174 my @size = $field->size;
175 my %extra = $field->extra;
176 my $list = $extra{'list'} || [];
77d74ea6 177 # \todo deal with embedded quotes
178 my $commalist = "'" . (join "', '", @$list) . "'";
44fcd0b5 179
180 if ( $data_type eq 'enum' ) {
44fcd0b5 181 $check = "CHECK ($field_name IN ($commalist))";
57f77285 182 $data_type = 'varchar2';
44fcd0b5 183 }
184 elsif ( $data_type eq 'set' ) {
185 # XXX add a CHECK constraint maybe
186 # (trickier and slower, than enum :)
57f77285 187 $data_type = 'varchar2';
44fcd0b5 188 }
189 else {
190 $data_type = defined $translate{ $data_type } ?
191 $translate{ $data_type } :
192 die "Unknown datatype: $data_type\n";
44fcd0b5 193 }
16dc9970 194
57f77285 195 $field_def .= " $data_type";
196 if ( defined $size[0] && $size[0] > 0 ) {
197 $field_def .= '(' . join( ', ', @size ) . ')';
198 }
199
16dc9970 200 #
201 # Default value
202 #
57f77285 203 my $default = $field->default_value;
204 if ( defined $default ) {
205 $field_def .= sprintf(
16dc9970 206 ' DEFAULT %s',
57f77285 207 $default =~ m/null/i ? 'NULL' : "'$default'"
16dc9970 208 );
209 }
210
211 #
212 # Not null constraint
213 #
57f77285 214 unless ( $field->is_nullable ) {
44fcd0b5 215 my $constraint_name = mk_name($field_name_ur, 'nn');
57f77285 216 $field_def .= ' CONSTRAINT ' . $constraint_name . ' NOT NULL';
16dc9970 217 }
218
57f77285 219 $field_def .= " $check" if $check;
44fcd0b5 220
16dc9970 221 #
222 # Auto_increment
223 #
57f77285 224 if ( $field->is_auto_increment ) {
44fcd0b5 225 my $base_name = $table_name . "_". $field_name;
226 my $seq_name = mk_name( $base_name, 'sq' );
227 my $trigger_name = mk_name( $base_name, 'ai' );
16dc9970 228
57f77285 229 push @trigger_defs,
44fcd0b5 230 "CREATE SEQUENCE $seq_name;\n" .
d529894e 231 "CREATE OR REPLACE TRIGGER $trigger_name\n" .
232 "BEFORE INSERT ON $table_name\n" .
44fcd0b5 233 "FOR EACH ROW WHEN (\n" .
234 " new.$field_name_ur IS NULL".
235 " OR new.$field_name_ur = 0\n".
236 ")\n".
d529894e 237 "BEGIN\n" .
44fcd0b5 238 " SELECT $seq_name.nextval\n" .
57f77285 239 " INTO :new." . $field->name."\n" .
16dc9970 240 " FROM dual;\n" .
44fcd0b5 241 "END;\n/";
16dc9970 242 ;
243 }
244
57f77285 245 if ( lc $field->data_type eq 'timestamp' ) {
44fcd0b5 246 my $base_name = $table_name . "_". $field_name_ur;
96844cae 247 my $trig_name = mk_name( $base_name, 'ts' );
57f77285 248 push @trigger_defs,
44fcd0b5 249 "CREATE OR REPLACE TRIGGER $trig_name\n".
250 "BEFORE INSERT OR UPDATE ON $table_name_ur\n".
b6ab0fe7 251 "FOR EACH ROW WHEN (new.$field_name_ur IS NULL)\n".
44fcd0b5 252 "BEGIN \n".
b6ab0fe7 253 " SELECT sysdate INTO :new.$field_name_ur FROM dual;\n".
44fcd0b5 254 "END;\n/";
255 }
256
57f77285 257 push @field_defs, $field_def;
f6195129 258
259 if ( my $comment = $field->comments ) {
260 push @field_comments,
261 "COMMENT ON COLUMN $table_name.$field_name_ur is\n '".
262 $comment."';";
263 }
57f77285 264 }
265
266 #
267 # Table constraints
268 #
269 my $constraint_name_default;
270 for my $c ( $table->get_constraints ) {
271 my $name = $c->name || '';
272 my @fields = map { unreserve( $_, $table_name ) } $c->fields;
273 my @rfields = map { unreserve( $_, $table_name ) }
274 $c->reference_fields;
275 next unless @fields;
276
277 if ( $c->type eq PRIMARY_KEY ) {
278 $name ||= mk_name( $table_name, 'pk' );
279 push @constraint_defs, "CONSTRAINT $name PRIMARY KEY ".
280 '(' . join( ', ', @fields ) . ')';
281 }
282 elsif ( $c->type eq UNIQUE ) {
283 $name ||= mk_name( $table_name, ++$constraint_name_default );
284 push @constraint_defs, "CONSTRAINT $name UNIQUE " .
285 '(' . join( ', ', @fields ) . ')';
286 }
287 elsif ( $c->type eq FOREIGN_KEY ) {
288 $name ||= mk_name( $table_name, ++$constraint_name_default );
cd617ba8 289 my $def = "CONSTRAINT $name FOREIGN KEY ";
290
291 if ( @fields ) {
292 $def .= join( ', ', @fields );
293 }
294
295 $def .= ' REFERENCES ' . $c->reference_table;
57f77285 296
297 if ( @rfields ) {
298 $def .= ' (' . join( ', ', @rfields ) . ')';
299 }
300
301 if ( $c->match_type ) {
302 $def .= ' MATCH ' .
303 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
304 }
305
306 if ( $c->on_delete ) {
307 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
308 }
309
310 if ( $c->on_update ) {
311 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
312 }
313
314 push @constraint_defs, $def;
315 }
16dc9970 316 }
317
318 #
319 # Index Declarations
320 #
57f77285 321 my @index_defs = ();
44fcd0b5 322 my $idx_name_default;
57f77285 323 for my $index ( $table->get_indices ) {
324 my $index_name = $index->name || '';
325 my $index_type = $index->type || NORMAL;
44fcd0b5 326 my @fields = map { unreserve( $_, $table_name ) }
57f77285 327 $index->fields;
44fcd0b5 328 next unless @fields;
16dc9970 329
57f77285 330 if ( $index_type eq PRIMARY_KEY ) {
44fcd0b5 331 $index_name = mk_name( $table_name, 'pk' );
57f77285 332 push @field_defs, 'CONSTRAINT '.$index_name.' PRIMARY KEY '.
16dc9970 333 '(' . join( ', ', @fields ) . ')';
334 }
57f77285 335 elsif ( $index_type eq UNIQUE ) {
44fcd0b5 336 $index_name = mk_name(
337 $table_name, $index_name || ++$idx_name_default
338 );
57f77285 339 push @field_defs, 'CONSTRAINT ' . $index_name . ' UNIQUE ' .
16dc9970 340 '(' . join( ', ', @fields ) . ')';
341 }
342
57f77285 343 elsif ( $index_type eq NORMAL ) {
44fcd0b5 344 $index_name = mk_name(
345 $table_name, $index_name || ++$idx_name_default
346 );
57f77285 347 push @index_defs,
da8e499e 348 "CREATE INDEX $index_name on $table_name_ur (".
349 join( ', ', @fields ).
350 ");";
16dc9970 351 }
16dc9970 352 else {
96844cae 353 warn "Unknown index type ($index_type) on table $table_name.\n"
354 if $WARN;
16dc9970 355 }
356 }
357
96844cae 358 my $create_statement;
359 $create_statement = "DROP TABLE $table_name_ur;\n" if $add_drop_table;
57f77285 360 $create_statement .=
361 join( ",\n", map { "-- $_" } $table->comments ) .
362 "CREATE TABLE $table_name_ur (\n" .
363 join( ",\n", map { " $_" } @field_defs, @constraint_defs ) .
44fcd0b5 364 "\n);"
16dc9970 365 ;
366
367 $output .= join( "\n\n",
368 @comments,
369 $create_statement,
57f77285 370 @trigger_defs,
371 @index_defs,
f6195129 372 @field_comments,
16dc9970 373 ''
374 );
375 }
376
96844cae 377 if ( $WARN ) {
378 if ( %truncated ) {
379 warn "Truncated " . keys( %truncated ) . " names:\n";
380 warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
381 }
382
383 if ( %unreserve ) {
384 warn "Encounted " . keys( %unreserve ) .
385 " unsafe names in schema (reserved or invalid):\n";
386 warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
387 }
388 }
389
d529894e 390 return $output;
16dc9970 391}
392
d529894e 393# -------------------------------------------------------------------
394sub mk_name {
57f77285 395 my $basename = shift || '';
396 my $type = shift || '';
397 my $scope = shift || '';
398 my $critical = shift || '';
d529894e 399 my $basename_orig = $basename;
f5087552 400 my $max_name = $type
401 ? $max_id_length - (length($type) + 1)
402 : $max_id_length;
96844cae 403 $basename = substr( $basename, 0, $max_name )
404 if length( $basename ) > $max_name;
d529894e 405 my $name = $type ? "${type}_$basename" : $basename;
406
407 if ( $basename ne $basename_orig and $critical ) {
408 my $show_type = $type ? "+'$type'" : "";
409 warn "Truncating '$basename_orig'$show_type to $max_id_length ",
96844cae 410 "character limit to make '$name'\n" if $WARN;
411 $truncated{ $basename_orig } = $name;
d529894e 412 }
413
414 $scope ||= \%global_names;
96844cae 415 if ( my $prev = $scope->{ $name } ) {
416 my $name_orig = $name;
417 $name .= sprintf( "%02d", ++$prev );
418 substr($name, $max_id_length - 3) = "00"
419 if length( $name ) > $max_id_length;
420
421 warn "The name '$name_orig' has been changed to ",
422 "'$name' to make it unique.\n" if $WARN;
423
424 $scope->{ $name_orig }++;
425 }
426
427 $scope->{ $name }++;
d529894e 428 return $name;
429}
430
431# -------------------------------------------------------------------
432sub unreserve {
57f77285 433 my $name = shift || '';
434 my $schema_obj_name = shift || '';
435
96844cae 436 my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
d529894e 437
438 # also trap fields that don't begin with a letter
57f77285 439 return $name if !$ora_reserved{ uc $name } && $name =~ /^[a-z]/i;
d529894e 440
441 if ( $schema_obj_name ) {
442 ++$unreserve{"$schema_obj_name.$name"};
443 }
444 else {
445 ++$unreserve{"$name (table name)"};
446 }
447
448 my $unreserve = sprintf '%s_', $name;
449 return $unreserve.$suffix;
450}
451
16dc9970 4521;
453
d529894e 454# -------------------------------------------------------------------
16dc9970 455# All bad art is the result of good intentions.
456# Oscar Wilde
d529894e 457# -------------------------------------------------------------------
16dc9970 458
459=head1 NAME
460
461SQL::Translator::Producer::Oracle - Oracle SQL producer
462
463=head1 SYNOPSIS
464
077ebf34 465 use SQL::Translator::Parser::MySQL;
16dc9970 466 use SQL::Translator::Producer::Oracle;
467
077ebf34 468 my $original_create = ""; # get this from somewhere...
469 my $translator = SQL::Translator->new;
470
471 $translator->parser("SQL::Translator::Parser::MySQL");
472 $translator->producer("SQL::Translator::Producer::Oracle");
473
474 my $new_create = $translator->translate($original_create);
475
16dc9970 476=head1 DESCRIPTION
477
077ebf34 478SQL::Translator::Producer::Oracle takes a parsed data structure,
479created by a SQL::Translator::Parser subclass, and turns it into a
480create string suitable for use with an Oracle database.
16dc9970 481
d529894e 482=head1 CREDITS
483
484A hearty "thank-you" to Tim Bunce for much of the logic stolen from
485his "mysql2ora" script.
16dc9970 486
487=head1 AUTHOR
488
d529894e 489Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
16dc9970 490
491=head1 SEE ALSO
492
493perl(1).
494
495=cut