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