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