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