projects / dbsrgits/SQL-Translator.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Adding tests for Oracle->add_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 ) {
017ac5a7 223 my ($field_create, $field_defs, $trigger_defs, $field_comments) =
224 create_field($field, $options, \%field_name_scope);
225 push @create, @$field_create if ref $field_create;
226 push @field_defs, @$field_defs if ref $field_defs;
227 push @trigger_defs, @$trigger_defs if ref $trigger_defs;
228 push @field_comments, @$field_comments if ref $field_comments;
57f77285 229 }
230
231 #
02c2af3b 232 # Table options
233 #
234 my @table_options;
235 for my $opt ( $table->options ) {
236 if ( ref $opt eq 'HASH' ) {
237 my ( $key, $value ) = each %$opt;
238 if ( ref $value eq 'ARRAY' ) {
239 push @table_options, "$key\n(\n". join ("\n",
240 map { " $_->[0]\t$_->[1]" }
241 map { [ each %$_ ] }
242 @$value
243 )."\n)";
244 }
245 elsif ( !defined $value ) {
246 push @table_options, $key;
247 }
248 else {
249 push @table_options, "$key $value";
250 }
251 }
252 }
253
254 #
57f77285 255 # Table constraints
256 #
57f77285 257 for my $c ( $table->get_constraints ) {
258 my $name = $c->name || '';
259 my @fields = map { unreserve( $_, $table_name ) } $c->fields;
260 my @rfields = map { unreserve( $_, $table_name ) }
261 $c->reference_fields;
4dfb0380 262 next if !@fields && $c->type ne CHECK_C;
57f77285 263
264 if ( $c->type eq PRIMARY_KEY ) {
d4977f1c 265 # create a name if delay_constraints
266 $name ||= mk_name( $table_name, 'pk' )
267 if $options->{delay_constraints};
54e61f1f 268 push @constraint_defs, ($name ? "CONSTRAINT $name " : '') .
269 'PRIMARY KEY (' . join( ', ', @fields ) . ')';
57f77285 270 }
271 elsif ( $c->type eq UNIQUE ) {
54e61f1f 272 # Don't create UNIQUE constraints identical to the primary key
273 if ( my $pk = $table->primary_key ) {
274 my $u_fields = join(":", @fields);
275 my $pk_fields = join(":", $pk->fields);
276 next if $u_fields eq $pk_fields;
277 }
278
279 $name ||= mk_name( $name || $table_name, 'u' );
6d4ce9b6 280
b0c196d4 281 for my $f ( $c->fields ) {
282 my $field_def = $table->get_field( $f ) or next;
283 my $dtype = $translate{ $field_def->data_type } or next;
284 if ( $WARN && $dtype =~ /clob/i ) {
285 warn "Oracle will not allow UNIQUE constraints on " .
286 "CLOB field '" . $field_def->table->name . '.' .
287 $field_def->name . ".'\n"
288 }
289 }
6d4ce9b6 290
57f77285 291 push @constraint_defs, "CONSTRAINT $name UNIQUE " .
292 '(' . join( ', ', @fields ) . ')';
293 }
4dfb0380 294 elsif ( $c->type eq CHECK_C ) {
54e61f1f 295 $name ||= mk_name( $name || $table_name, 'ck' );
4dfb0380 296 my $expression = $c->expression || '';
297 push @constraint_defs, "CONSTRAINT $name CHECK ($expression)";
298 }
57f77285 299 elsif ( $c->type eq FOREIGN_KEY ) {
e56dabb7 300 $name = mk_name( join('_', $table_name, $c->fields). '_fk' );
cd617ba8 301 my $def = "CONSTRAINT $name FOREIGN KEY ";
302
303 if ( @fields ) {
1c899510 304 $def .= '(' . join( ', ', @fields ) . ')';
cd617ba8 305 }
306
1c899510 307 my $ref_table = unreserve($c->reference_table);
308
309 $def .= " REFERENCES $ref_table";
57f77285 310
311 if ( @rfields ) {
312 $def .= ' (' . join( ', ', @rfields ) . ')';
313 }
314
315 if ( $c->match_type ) {
316 $def .= ' MATCH ' .
317 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
318 }
319
320 if ( $c->on_delete ) {
321 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
322 }
323
e56dabb7 324 # disabled by plu 2007-12-29 - doesn't exist for oracle
325 #if ( $c->on_update ) {
326 # $def .= ' ON UPDATE '.join( ' ', $c->on_update );
327 #}
57f77285 328
e56dabb7 329 push @fk_defs, sprintf("ALTER TABLE %s ADD %s;", $table, $def);
57f77285 330 }
16dc9970 331 }
332
333 #
334 # Index Declarations
335 #
57f77285 336 my @index_defs = ();
57f77285 337 for my $index ( $table->get_indices ) {
338 my $index_name = $index->name || '';
339 my $index_type = $index->type || NORMAL;
44fcd0b5 340 my @fields = map { unreserve( $_, $table_name ) }
57f77285 341 $index->fields;
44fcd0b5 342 next unless @fields;
16dc9970 343
bdd8e79a 344 my @index_options;
345 for my $opt ( $index->options ) {
346 if ( ref $opt eq 'HASH' ) {
347 my ( $key, $value ) = each %$opt;
348 if ( ref $value eq 'ARRAY' ) {
349 push @table_options, "$key\n(\n". join ("\n",
350 map { " $_->[0]\t$_->[1]" }
351 map { [ each %$_ ] }
352 @$value
353 )."\n)";
354 }
355 elsif ( !defined $value ) {
356 push @index_options, $key;
357 }
358 else {
359 push @index_options, "$key $value";
360 }
361 }
362 }
363 my $index_options = @index_options
364 ? "\n".join("\n", @index_options) : '';
365
57f77285 366 if ( $index_type eq PRIMARY_KEY ) {
6d4ce9b6 367 $index_name = $index_name ? mk_name( $index_name )
368 : mk_name( $table_name, 'pk' );
57f77285 369 push @field_defs, 'CONSTRAINT '.$index_name.' PRIMARY KEY '.
16dc9970 370 '(' . join( ', ', @fields ) . ')';
371 }
57f77285 372 elsif ( $index_type eq NORMAL ) {
6d4ce9b6 373 $index_name = $index_name ? mk_name( $index_name )
374 : mk_name( $table_name, $index_name || 'i' );
57f77285 375 push @index_defs,
da8e499e 376 "CREATE INDEX $index_name on $table_name_ur (".
377 join( ', ', @fields ).
bdd8e79a 378 ")$index_options;";
16dc9970 379 }
041e659f 380 elsif ( $index_type eq UNIQUE ) {
381 $index_name = $index_name ? mk_name( $index_name )
382 : mk_name( $table_name, $index_name || 'i' );
383 push @index_defs,
384 "CREATE UNIQUE INDEX $index_name on $table_name_ur (".
385 join( ', ', @fields ).
bdd8e79a 386 ")$index_options;";
041e659f 387 }
16dc9970 388 else {
96844cae 389 warn "Unknown index type ($index_type) on table $table_name.\n"
390 if $WARN;
16dc9970 391 }
392 }
393
9fc9bfb1 394 if ( my @table_comments = $table->comments ) {
395 for my $comment ( @table_comments ) {
396 next unless $comment;
b89d5635 397 $comment =~ s/'/''/g;
398 push @field_comments, "COMMENT ON TABLE $table_name_ur is\n '".
e56dabb7 399 $comment . "';" unless $options->{no_comments}
9fc9bfb1 400 ;
401 }
402 }
403
02c2af3b 404 my $table_options = @table_options
405 ? "\n".join("\n", @table_options) : '';
e56dabb7 406 push @create, "CREATE TABLE $table_name_ur (\n" .
65ffb46c 407 join( ",\n", map { " $_" } @field_defs,
408 ($options->{delay_constraints} ? () : @constraint_defs) ) .
409 "\n)$table_options;";
410
943ae54e 411 @constraint_defs = map { 'ALTER TABLE '.$table_name_ur.' ADD '.$_.';' }
65ffb46c 412 @constraint_defs;
16dc9970 413
96844cae 414 if ( $WARN ) {
415 if ( %truncated ) {
416 warn "Truncated " . keys( %truncated ) . " names:\n";
417 warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
418 }
419
420 if ( %unreserve ) {
421 warn "Encounted " . keys( %unreserve ) .
422 " unsafe names in schema (reserved or invalid):\n";
423 warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
424 }
425 }
426
65ffb46c 427 return \@create, \@fk_defs, \@trigger_defs, \@index_defs, ($options->{delay_constraints} ? \@constraint_defs : []);
e56dabb7 428}
429
017ac5a7 430sub alter_field {
431 my ($from_field, $to_field, $options) = @_;
432
433 my ($field_create, $field_defs, $trigger_defs, $field_comments) =
434 create_field($to_field, $options, {});
435
d888d445 436 # Fix ORA-01442
437 if ($to_field->is_nullable && !$from_field->is_nullable) {
438 die 'Cannot remove NOT NULL from table field';
439 } elsif (!$from_field->is_nullable && !$to_field->is_nullable) {
440 @$field_defs = map { s/ NOT NULL//; $_} @$field_defs;
441 }
442
017ac5a7 443 my $table_name = $to_field->table->name;
444 my $table_name_ur = unreserve( $table_name );
445
446 return 'ALTER TABLE '.$table_name_ur.' MODIFY ( '.join('', @$field_defs).' )';
447}
448
449sub create_field {
450 my ($field, $options, $field_name_scope) = @_;
451
452 my (@create, @field_defs, @trigger_defs, @field_comments);
453
454 my $table_name = $field->table->name;
455 my $table_name_ur = unreserve( $table_name );
456
457 #
458 # Field name
459 #
460 my $field_name = mk_name(
461 $field->name, '', $field_name_scope, 1
462 );
463
464 my $field_name_ur = unreserve( $field_name, $table_name );
465 my $field_def = $field_name_ur;
466 $field->name( $field_name_ur );
467
468 #
469 # Datatype
470 #
471 my $check;
472 my $data_type = lc $field->data_type;
473 my @size = $field->size;
474 my %extra = $field->extra;
475 my $list = $extra{'list'} || [];
476 # \todo deal with embedded quotes
477 my $commalist = join( ', ', map { qq['$_'] } @$list );
478
479 if ( $data_type eq 'enum' ) {
480 $check = "CHECK ($field_name_ur IN ($commalist))";
481 $data_type = 'varchar2';
482 }
483 elsif ( $data_type eq 'set' ) {
484 # XXX add a CHECK constraint maybe
485 # (trickier and slower, than enum :)
486 $data_type = 'varchar2';
487 }
488 else {
489 $data_type = defined $translate{ $data_type } ?
490 $translate{ $data_type } :
491 $data_type;
492 $data_type ||= 'varchar2';
493 }
494
495 #
496 # Fixes ORA-02329: column of datatype LOB cannot be
497 # unique or a primary key
498 #
499 if ( $data_type eq 'clob' && $field->is_primary_key ) {
500 $data_type = 'varchar2';
501 $size[0] = 4000;
502 warn "CLOB cannot be a primary key, changing to VARCHAR2\n"
503 if $WARN;
504 }
505
506 if ( $data_type eq 'clob' && $field->is_unique ) {
507 $data_type = 'varchar2';
508 $size[0] = 4000;
509 warn "CLOB cannot be a unique key, changing to VARCHAR2\n"
510 if $WARN;
511 }
512
513 #
514 # Fixes ORA-00907: missing right parenthesis
515 #
516 if ( $data_type =~ /(date|clob)/i ) {
517 undef @size;
518 }
519
520 $field_def .= " $data_type";
521 if ( defined $size[0] && $size[0] > 0 ) {
522 $field_def .= '(' . join( ', ', @size ) . ')';
523 }
524
525 #
526 # Default value
527 #
528 my $default = $field->default_value;
529 if ( defined $default ) {
530 #
531 # Wherein we try to catch a string being used as
532 # a default value for a numerical field. If "true/false,"
533 # then sub "1/0," otherwise just test the truthity of the
534 # argument and use that (naive?).
535 #
536 if (
537 $data_type =~ /^number$/i &&
538 $default !~ /^-?\d+$/ &&
539 $default !~ m/null/i
540 ) {
541 if ( $default =~ /^true$/i ) {
542 $default = "'1'";
543 } elsif ( $default =~ /^false$/i ) {
544 $default = "'0'";
545 } else {
546 $default = $default ? "'1'" : "'0'";
547 }
548 } elsif (
549 $data_type =~ /date/ && (
550 $default eq 'current_timestamp'
551 ||
552 $default eq 'now()'
553 )
554 ) {
555 $default = 'SYSDATE';
556 } else {
557 $default = $default =~ m/null/i ? 'NULL' : "'$default'"
558 }
559
560 $field_def .= " DEFAULT $default",
561 }
562
563 #
564 # Not null constraint
565 #
566 unless ( $field->is_nullable ) {
567 $field_def .= ' NOT NULL';
568 }
569
570 $field_def .= " $check" if $check;
571
572 #
573 # Auto_increment
574 #
575 if ( $field->is_auto_increment ) {
576 my $base_name = $table_name_ur . "_". $field_name;
577 my $seq_name = mk_name( $base_name, 'sq' );
578 my $trigger_name = mk_name( $base_name, 'ai' );
579
580 push @create, qq[DROP SEQUENCE $seq_name;] if $options->{add_drop_table};
581 push @create, "CREATE SEQUENCE $seq_name;";
582 push @trigger_defs,
583 "CREATE OR REPLACE TRIGGER $trigger_name\n" .
584 "BEFORE INSERT ON $table_name_ur\n" .
585 "FOR EACH ROW WHEN (\n" .
586 " new.$field_name_ur IS NULL".
587 " OR new.$field_name_ur = 0\n".
588 ")\n".
589 "BEGIN\n" .
590 " SELECT $seq_name.nextval\n" .
591 " INTO :new." . $field->name."\n" .
592 " FROM dual;\n" .
593 "END;\n/";
594 ;
595 }
596
597 if ( lc $field->data_type eq 'timestamp' ) {
598 my $base_name = $table_name_ur . "_". $field_name_ur;
599 my $trig_name = mk_name( $base_name, 'ts' );
600 push @trigger_defs,
601 "CREATE OR REPLACE TRIGGER $trig_name\n".
602 "BEFORE INSERT OR UPDATE ON $table_name_ur\n".
603 "FOR EACH ROW WHEN (new.$field_name_ur IS NULL)\n".
604 "BEGIN \n".
605 " SELECT sysdate INTO :new.$field_name_ur FROM dual;\n".
606 "END;\n/";
607 }
608
609 push @field_defs, $field_def;
610
611 if ( my $comment = $field->comments ) {
612 $comment =~ s/'/''/g;
613 push @field_comments,
614 "COMMENT ON COLUMN $table_name_ur.$field_name_ur is\n '" .
615 $comment . "';" unless $options->{no_comments};
616 }
617
618 return \@create, \@field_defs, \@trigger_defs, \@field_comments;
619
620}
621
622
e56dabb7 623sub create_view {
624 my ($view) = @_;
625
626 my $out = sprintf("CREATE VIEW %s AS\n%s;",
627 $view->name,
628 $view->sql);
629
630 return $out;
16dc9970 631}
632
d529894e 633# -------------------------------------------------------------------
634sub mk_name {
57f77285 635 my $basename = shift || '';
636 my $type = shift || '';
1c899510 637 $type = '' if $type =~ /^\d/;
57f77285 638 my $scope = shift || '';
639 my $critical = shift || '';
d529894e 640 my $basename_orig = $basename;
f5087552 641 my $max_name = $type
642 ? $max_id_length - (length($type) + 1)
643 : $max_id_length;
96844cae 644 $basename = substr( $basename, 0, $max_name )
645 if length( $basename ) > $max_name;
d529894e 646 my $name = $type ? "${type}_$basename" : $basename;
647
648 if ( $basename ne $basename_orig and $critical ) {
649 my $show_type = $type ? "+'$type'" : "";
650 warn "Truncating '$basename_orig'$show_type to $max_id_length ",
96844cae 651 "character limit to make '$name'\n" if $WARN;
652 $truncated{ $basename_orig } = $name;
d529894e 653 }
654
655 $scope ||= \%global_names;
96844cae 656 if ( my $prev = $scope->{ $name } ) {
657 my $name_orig = $name;
b89d5635 658 substr($name, $max_id_length - 2) = ""
659 if length( $name ) >= $max_id_length - 1;
660 $name .= sprintf( "%02d", $prev++ );
96844cae 661
662 warn "The name '$name_orig' has been changed to ",
663 "'$name' to make it unique.\n" if $WARN;
664
665 $scope->{ $name_orig }++;
666 }
667
668 $scope->{ $name }++;
d529894e 669 return $name;
670}
671
672# -------------------------------------------------------------------
673sub unreserve {
57f77285 674 my $name = shift || '';
675 my $schema_obj_name = shift || '';
676
96844cae 677 my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
d529894e 678
679 # also trap fields that don't begin with a letter
57f77285 680 return $name if !$ora_reserved{ uc $name } && $name =~ /^[a-z]/i;
d529894e 681
682 if ( $schema_obj_name ) {
683 ++$unreserve{"$schema_obj_name.$name"};
684 }
685 else {
686 ++$unreserve{"$name (table name)"};
687 }
688
689 my $unreserve = sprintf '%s_', $name;
690 return $unreserve.$suffix;
691}
692
16dc9970 6931;
694
d529894e 695# -------------------------------------------------------------------
16dc9970 696# All bad art is the result of good intentions.
697# Oscar Wilde
d529894e 698# -------------------------------------------------------------------
16dc9970 699
ba096dc4 700=pod
16dc9970 701
d529894e 702=head1 CREDITS
703
ba096dc4 704Mad props to Tim Bunce for much of the logic stolen from his "mysql2ora"
705script.
16dc9970 706
707=head1 AUTHOR
708
ba096dc4 709Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
16dc9970 710
711=head1 SEE ALSO
712
ba096dc4 713SQL::Translator, DDL::Oracle, mysql2ora.
16dc9970 714
715=cut
DDL Tool (dbsrgits@git.shadowcat.co.uk:SQL-Translator.git)