projects / dbsrgits/SQL-Translator.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Strip evil svn:keywords
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / Oracle.pm
CommitLineData
16dc9970 1package SQL::Translator::Producer::Oracle;
2
077ebf34 3# -------------------------------------------------------------------
d4f84dd1 4# $Id: Oracle.pm 1440 2009-01-17 16:31:57Z jawnsy $
077ebf34 5# -------------------------------------------------------------------
478f608d 6# Copyright (C) 2002-2009 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
2c5e6626 49=head1 NOTES
50
51=head2 Autoincremental primary keys
52
53This producer uses sequences and triggers to autoincrement primary key
54columns, if necessary. SQLPlus and DBI expect a slightly different syntax
55of CREATE TRIGGER statement. You might have noticed that this
56producer returns a scalar containing all statements concatenated by
57newlines or an array of single statements depending on the context
58(scalar, array) it has been called in.
59
60SQLPlus expects following trigger syntax:
61
62 CREATE OR REPLACE TRIGGER ai_person_id
63 BEFORE INSERT ON person
64 FOR EACH ROW WHEN (
65 new.id IS NULL OR new.id = 0
66 )
67 BEGIN
68 SELECT sq_person_id.nextval
69 INTO :new.id
70 FROM dual;
71 END;
72 /
73
74Whereas if you want to create the same trigger using L<DBI/do>, you need
75to omit the last slash:
76
77 my $dbh = DBI->connect('dbi:Oracle:mysid', 'scott', 'tiger');
78 $dbh->do("
79 CREATE OR REPLACE TRIGGER ai_person_id
80 BEFORE INSERT ON person
81 FOR EACH ROW WHEN (
82 new.id IS NULL OR new.id = 0
83 )
84 BEGIN
85 SELECT sq_person_id.nextval
86 INTO :new.id
87 FROM dual;
88 END;
89 ");
90
91If you call this producer in array context, we expect you want to process
92the returned array of statements using L<DBI> like
93L<DBIx::Class::Schema/deploy> does.
94
95To get this working we removed the slash in those statements in version
960.09002 of L<SQL::Translator> when called in array context. In scalar
97context the slash will be still there to ensure compatibility with SQLPlus.
98
ba096dc4 99=cut
100
16dc9970 101use strict;
478f608d 102use vars qw[ $DEBUG $WARN ];
d529894e 103$DEBUG = 0 unless defined $DEBUG;
16dc9970 104
57f77285 105use SQL::Translator::Schema::Constants;
5ee19df8 106use SQL::Translator::Utils qw(header_comment);
107
16dc9970 108my %translate = (
d529894e 109 #
110 # MySQL types
111 #
16dc9970 112 bigint => 'number',
113 double => 'number',
114 decimal => 'number',
115 float => 'number',
116 int => 'number',
25966689 117 integer => 'number',
16dc9970 118 mediumint => 'number',
119 smallint => 'number',
120 tinyint => 'number',
16dc9970 121 char => 'char',
16dc9970 122 varchar => 'varchar2',
1f58ba76 123 tinyblob => 'blob',
124 blob => 'blob',
125 mediumblob => 'blob',
126 longblob => 'blob',
9fc9bfb1 127 tinytext => 'varchar2',
128 text => 'clob',
1f58ba76 129 longtext => 'clob',
130 mediumtext => 'clob',
16dc9970 131 enum => 'varchar2',
132 set => 'varchar2',
16dc9970 133 date => 'date',
134 datetime => 'date',
135 time => 'date',
136 timestamp => 'date',
137 year => 'date',
d529894e 138
139 #
140 # PostgreSQL types
141 #
57f77285 142 numeric => 'number',
143 'double precision' => 'number',
144 serial => 'number',
145 bigserial => 'number',
146 money => 'number',
147 character => 'char',
148 'character varying' => 'varchar2',
149 bytea => 'BLOB',
150 interval => 'number',
151 boolean => 'number',
152 point => 'number',
153 line => 'number',
154 lseg => 'number',
155 box => 'number',
156 path => 'number',
157 polygon => 'number',
158 circle => 'number',
159 cidr => 'number',
160 inet => 'varchar2',
161 macaddr => 'varchar2',
162 bit => 'number',
163 'bit varying' => 'number',
ab8802d7 164
165 #
166 # Oracle types
167 #
168 number => 'number',
169 varchar2 => 'varchar2',
170 long => 'clob',
d529894e 171);
172
173#
174# Oracle reserved words from:
175# http://technet.oracle.com/docs/products/oracle8i/doc_library/\
176# 817_doc/server.817/a85397/ap_keywd.htm
177#
96844cae 178my %ora_reserved = map { $_, 1 } qw(
d529894e 179 ACCESS ADD ALL ALTER AND ANY AS ASC AUDIT
180 BETWEEN BY
181 CHAR CHECK CLUSTER COLUMN COMMENT COMPRESS CONNECT CREATE CURRENT
182 DATE DECIMAL DEFAULT DELETE DESC DISTINCT DROP
183 ELSE EXCLUSIVE EXISTS
184 FILE FLOAT FOR FROM
185 GRANT GROUP
186 HAVING
187 IDENTIFIED IMMEDIATE IN INCREMENT INDEX INITIAL INSERT
188 INTEGER INTERSECT INTO IS
189 LEVEL LIKE LOCK LONG
190 MAXEXTENTS MINUS MLSLABEL MODE MODIFY
191 NOAUDIT NOCOMPRESS NOT NOWAIT NULL NUMBER
192 OF OFFLINE ON ONLINE OPTION OR ORDER
193 PCTFREE PRIOR PRIVILEGES PUBLIC
194 RAW RENAME RESOURCE REVOKE ROW ROWID ROWNUM ROWS
195 SELECT SESSION SET SHARE SIZE SMALLINT START
196 SUCCESSFUL SYNONYM SYSDATE
197 TABLE THEN TO TRIGGER
198 UID UNION UNIQUE UPDATE USER
199 VALIDATE VALUES VARCHAR VARCHAR2 VIEW
200 WHENEVER WHERE WITH
16dc9970 201);
202
e3aac687 203#
204# Oracle 8/9 max size of data types from:
205# http://www.ss64.com/orasyntax/datatypes.html
206#
207my %max_size = (
208 char => 2000,
209 nchar => 2000,
210 nvarchar2 => 4000,
211 number => [ 38, 127 ],
212 raw => 2000,
213 varchar => 4000, # only synonym for varchar2
214 varchar2 => 4000,
215);
216
96844cae 217my $max_id_length = 30;
218my %used_identifiers = ();
d529894e 219my %global_names;
220my %unreserve;
221my %truncated;
16dc9970 222
96844cae 223# -------------------------------------------------------------------
077ebf34 224sub produce {
a1d94525 225 my $translator = shift;
226 $DEBUG = $translator->debug;
e56dabb7 227 $WARN = $translator->show_warnings || 0;
a1d94525 228 my $no_comments = $translator->no_comments;
229 my $add_drop_table = $translator->add_drop_table;
230 my $schema = $translator->schema;
65ffb46c 231 my $delay_constraints = $translator->producer_args->{delay_constraints};
232 my ($output, $create, @table_defs, @fk_defs, @trigger_defs, @index_defs, @constraint_defs);
44fcd0b5 233
e56dabb7 234 $create .= header_comment unless ($no_comments);
077ebf34 235
d529894e 236 if ( $translator->parser_type =~ /mysql/i ) {
e56dabb7 237 $create .=
ba3cb849 238 "-- We assume that default NLS_DATE_FORMAT has been changed\n".
239 "-- but we set it here anyway to be self-consistent.\n"
240 unless $no_comments;
241
e56dabb7 242 $create .=
d529894e 243 "ALTER SESSION SET NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS';\n\n";
244 }
16dc9970 245
57f77285 246 for my $table ( $schema->get_tables ) {
535e5c95 247 my ( $table_def, $fk_def, $trigger_def, $index_def, $constraint_def ) = create_table(
e56dabb7 248 $table,
249 {
535e5c95 250 add_drop_table => $add_drop_table,
251 show_warnings => $WARN,
252 no_comments => $no_comments,
253 delay_constraints => $delay_constraints,
254 wantarray => wantarray ? 1 : 0,
e56dabb7 255 }
256 );
257 push @table_defs, @$table_def;
258 push @fk_defs, @$fk_def;
259 push @trigger_defs, @$trigger_def;
041e659f 260 push @index_defs, @$index_def;
65ffb46c 261 push @constraint_defs, @$constraint_def;
e56dabb7 262 }
263
264 my (@view_defs);
265 foreach my $view ( $schema->get_views ) {
266 push @view_defs, create_view($view);
267 }
268
f92d79aa 269 if (wantarray) {
270 return defined $create ? $create : (), @table_defs, @view_defs, @fk_defs, @trigger_defs, @index_defs, @constraint_defs;
271 }
272 else {
273 $create .= join ('', map { $_ ? "$_;\n\n" : () } @table_defs, @view_defs, @fk_defs, @index_defs, @constraint_defs);
274 # triggers may NOT end with a semicolon
275 $create .= join "\n\n", @trigger_defs;
276 return $create;
277 }
e56dabb7 278}
279
280sub create_table {
281 my ($table, $options) = @_;
282 my $table_name = $table->name;
283
284 my $item = '';
285 my $drop;
286 my (@create, @field_defs, @constraint_defs, @fk_defs, @trigger_defs);
16dc9970 287
e56dabb7 288 my $table_name_ur = unreserve($table_name) or next;
16dc9970 289
a7f999aa 290 push @create, "--\n-- Table: $table_name_ur\n--" unless $options->{no_comments};
291 push @create, qq[DROP TABLE $table_name_ur CASCADE CONSTRAINTS] if $options->{add_drop_table};
292
f6195129 293 my ( %field_name_scope, @field_comments );
57f77285 294 for my $field ( $table->get_fields ) {
017ac5a7 295 my ($field_create, $field_defs, $trigger_defs, $field_comments) =
296 create_field($field, $options, \%field_name_scope);
297 push @create, @$field_create if ref $field_create;
298 push @field_defs, @$field_defs if ref $field_defs;
299 push @trigger_defs, @$trigger_defs if ref $trigger_defs;
300 push @field_comments, @$field_comments if ref $field_comments;
57f77285 301 }
302
303 #
02c2af3b 304 # Table options
305 #
306 my @table_options;
307 for my $opt ( $table->options ) {
308 if ( ref $opt eq 'HASH' ) {
309 my ( $key, $value ) = each %$opt;
310 if ( ref $value eq 'ARRAY' ) {
311 push @table_options, "$key\n(\n". join ("\n",
312 map { " $_->[0]\t$_->[1]" }
313 map { [ each %$_ ] }
314 @$value
315 )."\n)";
316 }
317 elsif ( !defined $value ) {
318 push @table_options, $key;
319 }
320 else {
321 push @table_options, "$key $value";
322 }
323 }
324 }
325
326 #
57f77285 327 # Table constraints
328 #
57f77285 329 for my $c ( $table->get_constraints ) {
330 my $name = $c->name || '';
331 my @fields = map { unreserve( $_, $table_name ) } $c->fields;
332 my @rfields = map { unreserve( $_, $table_name ) }
333 $c->reference_fields;
4dfb0380 334 next if !@fields && $c->type ne CHECK_C;
57f77285 335
336 if ( $c->type eq PRIMARY_KEY ) {
d4977f1c 337 # create a name if delay_constraints
338 $name ||= mk_name( $table_name, 'pk' )
339 if $options->{delay_constraints};
54e61f1f 340 push @constraint_defs, ($name ? "CONSTRAINT $name " : '') .
341 'PRIMARY KEY (' . join( ', ', @fields ) . ')';
57f77285 342 }
343 elsif ( $c->type eq UNIQUE ) {
54e61f1f 344 # Don't create UNIQUE constraints identical to the primary key
345 if ( my $pk = $table->primary_key ) {
346 my $u_fields = join(":", @fields);
347 my $pk_fields = join(":", $pk->fields);
348 next if $u_fields eq $pk_fields;
349 }
350
351 $name ||= mk_name( $name || $table_name, 'u' );
6d4ce9b6 352
b0c196d4 353 for my $f ( $c->fields ) {
354 my $field_def = $table->get_field( $f ) or next;
355 my $dtype = $translate{ $field_def->data_type } or next;
356 if ( $WARN && $dtype =~ /clob/i ) {
357 warn "Oracle will not allow UNIQUE constraints on " .
358 "CLOB field '" . $field_def->table->name . '.' .
359 $field_def->name . ".'\n"
360 }
361 }
6d4ce9b6 362
57f77285 363 push @constraint_defs, "CONSTRAINT $name UNIQUE " .
364 '(' . join( ', ', @fields ) . ')';
365 }
4dfb0380 366 elsif ( $c->type eq CHECK_C ) {
54e61f1f 367 $name ||= mk_name( $name || $table_name, 'ck' );
4dfb0380 368 my $expression = $c->expression || '';
369 push @constraint_defs, "CONSTRAINT $name CHECK ($expression)";
370 }
57f77285 371 elsif ( $c->type eq FOREIGN_KEY ) {
541d6e24 372 $name = mk_name( join('_', $table_name, $c->fields). '_fk' );
cd617ba8 373 my $def = "CONSTRAINT $name FOREIGN KEY ";
374
375 if ( @fields ) {
1c899510 376 $def .= '(' . join( ', ', @fields ) . ')';
cd617ba8 377 }
378
1c899510 379 my $ref_table = unreserve($c->reference_table);
380
381 $def .= " REFERENCES $ref_table";
57f77285 382
383 if ( @rfields ) {
384 $def .= ' (' . join( ', ', @rfields ) . ')';
385 }
386
387 if ( $c->match_type ) {
388 $def .= ' MATCH ' .
389 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
390 }
391
392 if ( $c->on_delete ) {
393 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
394 }
395
541d6e24 396 # disabled by plu 2007-12-29 - doesn't exist for oracle
397 #if ( $c->on_update ) {
398 # $def .= ' ON UPDATE '.join( ' ', $c->on_update );
399 #}
57f77285 400
541d6e24 401 push @fk_defs, sprintf("ALTER TABLE %s ADD %s", $table_name_ur, $def);
57f77285 402 }
16dc9970 403 }
404
405 #
406 # Index Declarations
407 #
57f77285 408 my @index_defs = ();
57f77285 409 for my $index ( $table->get_indices ) {
410 my $index_name = $index->name || '';
411 my $index_type = $index->type || NORMAL;
44fcd0b5 412 my @fields = map { unreserve( $_, $table_name ) }
57f77285 413 $index->fields;
44fcd0b5 414 next unless @fields;
16dc9970 415
bdd8e79a 416 my @index_options;
417 for my $opt ( $index->options ) {
418 if ( ref $opt eq 'HASH' ) {
419 my ( $key, $value ) = each %$opt;
420 if ( ref $value eq 'ARRAY' ) {
421 push @table_options, "$key\n(\n". join ("\n",
422 map { " $_->[0]\t$_->[1]" }
423 map { [ each %$_ ] }
424 @$value
425 )."\n)";
426 }
427 elsif ( !defined $value ) {
428 push @index_options, $key;
429 }
430 else {
431 push @index_options, "$key $value";
432 }
433 }
434 }
435 my $index_options = @index_options
436 ? "\n".join("\n", @index_options) : '';
437
57f77285 438 if ( $index_type eq PRIMARY_KEY ) {
6d4ce9b6 439 $index_name = $index_name ? mk_name( $index_name )
440 : mk_name( $table_name, 'pk' );
57f77285 441 push @field_defs, 'CONSTRAINT '.$index_name.' PRIMARY KEY '.
16dc9970 442 '(' . join( ', ', @fields ) . ')';
443 }
57f77285 444 elsif ( $index_type eq NORMAL ) {
6d4ce9b6 445 $index_name = $index_name ? mk_name( $index_name )
446 : mk_name( $table_name, $index_name || 'i' );
57f77285 447 push @index_defs,
da8e499e 448 "CREATE INDEX $index_name on $table_name_ur (".
449 join( ', ', @fields ).
4dec2e49 450 ")$index_options";
16dc9970 451 }
041e659f 452 elsif ( $index_type eq UNIQUE ) {
453 $index_name = $index_name ? mk_name( $index_name )
454 : mk_name( $table_name, $index_name || 'i' );
455 push @index_defs,
456 "CREATE UNIQUE INDEX $index_name on $table_name_ur (".
457 join( ', ', @fields ).
4dec2e49 458 ")$index_options";
041e659f 459 }
16dc9970 460 else {
96844cae 461 warn "Unknown index type ($index_type) on table $table_name.\n"
462 if $WARN;
16dc9970 463 }
464 }
465
9fc9bfb1 466 if ( my @table_comments = $table->comments ) {
467 for my $comment ( @table_comments ) {
468 next unless $comment;
b89d5635 469 $comment =~ s/'/''/g;
470 push @field_comments, "COMMENT ON TABLE $table_name_ur is\n '".
4dec2e49 471 $comment . "'" unless $options->{no_comments}
9fc9bfb1 472 ;
473 }
474 }
475
02c2af3b 476 my $table_options = @table_options
477 ? "\n".join("\n", @table_options) : '';
e56dabb7 478 push @create, "CREATE TABLE $table_name_ur (\n" .
65ffb46c 479 join( ",\n", map { " $_" } @field_defs,
480 ($options->{delay_constraints} ? () : @constraint_defs) ) .
4dec2e49 481 "\n)$table_options";
65ffb46c 482
4dec2e49 483 @constraint_defs = map { 'ALTER TABLE '.$table_name_ur.' ADD '.$_ }
65ffb46c 484 @constraint_defs;
16dc9970 485
96844cae 486 if ( $WARN ) {
487 if ( %truncated ) {
488 warn "Truncated " . keys( %truncated ) . " names:\n";
489 warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
490 }
491
492 if ( %unreserve ) {
493 warn "Encounted " . keys( %unreserve ) .
494 " unsafe names in schema (reserved or invalid):\n";
495 warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
496 }
497 }
498
65ffb46c 499 return \@create, \@fk_defs, \@trigger_defs, \@index_defs, ($options->{delay_constraints} ? \@constraint_defs : []);
e56dabb7 500}
501
017ac5a7 502sub alter_field {
503 my ($from_field, $to_field, $options) = @_;
504
505 my ($field_create, $field_defs, $trigger_defs, $field_comments) =
506 create_field($to_field, $options, {});
507
d888d445 508 # Fix ORA-01442
509 if ($to_field->is_nullable && !$from_field->is_nullable) {
510 die 'Cannot remove NOT NULL from table field';
511 } elsif (!$from_field->is_nullable && !$to_field->is_nullable) {
512 @$field_defs = map { s/ NOT NULL//; $_} @$field_defs;
513 }
514
017ac5a7 515 my $table_name = $to_field->table->name;
516 my $table_name_ur = unreserve( $table_name );
517
518 return 'ALTER TABLE '.$table_name_ur.' MODIFY ( '.join('', @$field_defs).' )';
519}
520
fe9f1470 521sub add_field {
522 my ($new_field, $options) = @_;
523
524 my ($field_create, $field_defs, $trigger_defs, $field_comments) =
525 create_field($new_field, $options, {});
526
527 my $table_name = $new_field->table->name;
528 my $table_name_ur = unreserve( $table_name );
529
530 my $out = sprintf('ALTER TABLE %s ADD ( %s )',
531 $table_name_ur,
532 join('', @$field_defs));
533 return $out;
534}
535
017ac5a7 536sub create_field {
537 my ($field, $options, $field_name_scope) = @_;
538
539 my (@create, @field_defs, @trigger_defs, @field_comments);
540
541 my $table_name = $field->table->name;
542 my $table_name_ur = unreserve( $table_name );
543
544 #
545 # Field name
546 #
547 my $field_name = mk_name(
548 $field->name, '', $field_name_scope, 1
549 );
550
551 my $field_name_ur = unreserve( $field_name, $table_name );
552 my $field_def = $field_name_ur;
553 $field->name( $field_name_ur );
554
555 #
556 # Datatype
557 #
558 my $check;
559 my $data_type = lc $field->data_type;
560 my @size = $field->size;
561 my %extra = $field->extra;
562 my $list = $extra{'list'} || [];
563 # \todo deal with embedded quotes
564 my $commalist = join( ', ', map { qq['$_'] } @$list );
565
566 if ( $data_type eq 'enum' ) {
567 $check = "CHECK ($field_name_ur IN ($commalist))";
568 $data_type = 'varchar2';
569 }
570 elsif ( $data_type eq 'set' ) {
571 # XXX add a CHECK constraint maybe
572 # (trickier and slower, than enum :)
573 $data_type = 'varchar2';
574 }
575 else {
576 $data_type = defined $translate{ $data_type } ?
577 $translate{ $data_type } :
578 $data_type;
579 $data_type ||= 'varchar2';
580 }
e3aac687 581
582 # ensure size is not bigger than max size oracle allows for data type
583 if ( defined $max_size{$data_type} ) {
584 for ( my $i = 0 ; $i < scalar @size ; $i++ ) {
585 my $max =
586 ref( $max_size{$data_type} ) eq 'ARRAY'
587 ? $max_size{$data_type}->[$i]
588 : $max_size{$data_type};
589 $size[$i] = $max if $size[$i] > $max;
590 }
591 }
017ac5a7 592
593 #
594 # Fixes ORA-02329: column of datatype LOB cannot be
595 # unique or a primary key
596 #
597 if ( $data_type eq 'clob' && $field->is_primary_key ) {
598 $data_type = 'varchar2';
599 $size[0] = 4000;
600 warn "CLOB cannot be a primary key, changing to VARCHAR2\n"
601 if $WARN;
602 }
603
604 if ( $data_type eq 'clob' && $field->is_unique ) {
605 $data_type = 'varchar2';
606 $size[0] = 4000;
607 warn "CLOB cannot be a unique key, changing to VARCHAR2\n"
608 if $WARN;
609 }
610
611 #
612 # Fixes ORA-00907: missing right parenthesis
613 #
614 if ( $data_type =~ /(date|clob)/i ) {
615 undef @size;
616 }
617
618 $field_def .= " $data_type";
619 if ( defined $size[0] && $size[0] > 0 ) {
620 $field_def .= '(' . join( ', ', @size ) . ')';
621 }
622
623 #
624 # Default value
625 #
626 my $default = $field->default_value;
627 if ( defined $default ) {
628 #
629 # Wherein we try to catch a string being used as
630 # a default value for a numerical field. If "true/false,"
631 # then sub "1/0," otherwise just test the truthity of the
632 # argument and use that (naive?).
633 #
bc8e2aa1 634 if (ref $default and defined $$default) {
635 $default = $$default;
636 } elsif (ref $default) {
637 $default = 'NULL';
638 } elsif (
017ac5a7 639 $data_type =~ /^number$/i &&
640 $default !~ /^-?\d+$/ &&
641 $default !~ m/null/i
642 ) {
643 if ( $default =~ /^true$/i ) {
644 $default = "'1'";
645 } elsif ( $default =~ /^false$/i ) {
646 $default = "'0'";
647 } else {
648 $default = $default ? "'1'" : "'0'";
649 }
650 } elsif (
651 $data_type =~ /date/ && (
652 $default eq 'current_timestamp'
653 ||
654 $default eq 'now()'
655 )
656 ) {
657 $default = 'SYSDATE';
658 } else {
659 $default = $default =~ m/null/i ? 'NULL' : "'$default'"
660 }
661
662 $field_def .= " DEFAULT $default",
663 }
664
665 #
666 # Not null constraint
667 #
668 unless ( $field->is_nullable ) {
669 $field_def .= ' NOT NULL';
670 }
671
672 $field_def .= " $check" if $check;
673
674 #
675 # Auto_increment
676 #
677 if ( $field->is_auto_increment ) {
678 my $base_name = $table_name_ur . "_". $field_name;
679 my $seq_name = mk_name( $base_name, 'sq' );
680 my $trigger_name = mk_name( $base_name, 'ai' );
681
4dec2e49 682 push @create, qq[DROP SEQUENCE $seq_name] if $options->{add_drop_table};
683 push @create, "CREATE SEQUENCE $seq_name";
535e5c95 684 my $trigger =
017ac5a7 685 "CREATE OR REPLACE TRIGGER $trigger_name\n" .
686 "BEFORE INSERT ON $table_name_ur\n" .
687 "FOR EACH ROW WHEN (\n" .
688 " new.$field_name_ur IS NULL".
689 " OR new.$field_name_ur = 0\n".
690 ")\n".
691 "BEGIN\n" .
692 " SELECT $seq_name.nextval\n" .
693 " INTO :new." . $field->name."\n" .
694 " FROM dual;\n" .
535e5c95 695 "END;\n";
696
697 #
698 # If wantarray is set we have to omit the last "/" in this statement so it
699 # can be executed by DBI->do() directly.
700 #
701 $trigger .= "/" unless $options->{wantarray};
702
703 push @trigger_defs, $trigger;
017ac5a7 704 }
705
706 if ( lc $field->data_type eq 'timestamp' ) {
707 my $base_name = $table_name_ur . "_". $field_name_ur;
708 my $trig_name = mk_name( $base_name, 'ts' );
535e5c95 709 my $trigger =
017ac5a7 710 "CREATE OR REPLACE TRIGGER $trig_name\n".
711 "BEFORE INSERT OR UPDATE ON $table_name_ur\n".
712 "FOR EACH ROW WHEN (new.$field_name_ur IS NULL)\n".
713 "BEGIN \n".
714 " SELECT sysdate INTO :new.$field_name_ur FROM dual;\n".
535e5c95 715 "END;\n";
716
717 #
718 # If wantarray is set we have to omit the last "/" in this statement so it
719 # can be executed by DBI->do() directly.
720 #
721 $trigger .= "/" unless $options->{wantarray};
722
723 push @trigger_defs, $trigger;
017ac5a7 724 }
725
726 push @field_defs, $field_def;
727
728 if ( my $comment = $field->comments ) {
729 $comment =~ s/'/''/g;
730 push @field_comments,
731 "COMMENT ON COLUMN $table_name_ur.$field_name_ur is\n '" .
732 $comment . "';" unless $options->{no_comments};
733 }
734
735 return \@create, \@field_defs, \@trigger_defs, \@field_comments;
736
737}
738
739
e56dabb7 740sub create_view {
741 my ($view) = @_;
742
13db351b 743 my $out = sprintf("CREATE VIEW %s AS\n%s",
e56dabb7 744 $view->name,
745 $view->sql);
746
747 return $out;
16dc9970 748}
749
d529894e 750# -------------------------------------------------------------------
751sub mk_name {
57f77285 752 my $basename = shift || '';
753 my $type = shift || '';
1c899510 754 $type = '' if $type =~ /^\d/;
57f77285 755 my $scope = shift || '';
756 my $critical = shift || '';
d529894e 757 my $basename_orig = $basename;
f5087552 758 my $max_name = $type
759 ? $max_id_length - (length($type) + 1)
760 : $max_id_length;
96844cae 761 $basename = substr( $basename, 0, $max_name )
762 if length( $basename ) > $max_name;
d529894e 763 my $name = $type ? "${type}_$basename" : $basename;
764
765 if ( $basename ne $basename_orig and $critical ) {
766 my $show_type = $type ? "+'$type'" : "";
767 warn "Truncating '$basename_orig'$show_type to $max_id_length ",
96844cae 768 "character limit to make '$name'\n" if $WARN;
769 $truncated{ $basename_orig } = $name;
d529894e 770 }
771
772 $scope ||= \%global_names;
96844cae 773 if ( my $prev = $scope->{ $name } ) {
774 my $name_orig = $name;
b89d5635 775 substr($name, $max_id_length - 2) = ""
776 if length( $name ) >= $max_id_length - 1;
777 $name .= sprintf( "%02d", $prev++ );
96844cae 778
779 warn "The name '$name_orig' has been changed to ",
780 "'$name' to make it unique.\n" if $WARN;
781
782 $scope->{ $name_orig }++;
783 }
784
785 $scope->{ $name }++;
d529894e 786 return $name;
787}
788
789# -------------------------------------------------------------------
790sub unreserve {
57f77285 791 my $name = shift || '';
792 my $schema_obj_name = shift || '';
793
96844cae 794 my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
d529894e 795
796 # also trap fields that don't begin with a letter
57f77285 797 return $name if !$ora_reserved{ uc $name } && $name =~ /^[a-z]/i;
d529894e 798
799 if ( $schema_obj_name ) {
800 ++$unreserve{"$schema_obj_name.$name"};
801 }
802 else {
803 ++$unreserve{"$name (table name)"};
804 }
805
806 my $unreserve = sprintf '%s_', $name;
807 return $unreserve.$suffix;
808}
809
16dc9970 8101;
811
d529894e 812# -------------------------------------------------------------------
16dc9970 813# All bad art is the result of good intentions.
814# Oscar Wilde
d529894e 815# -------------------------------------------------------------------
16dc9970 816
ba096dc4 817=pod
16dc9970 818
d529894e 819=head1 CREDITS
820
ba096dc4 821Mad props to Tim Bunce for much of the logic stolen from his "mysql2ora"
822script.
16dc9970 823
824=head1 AUTHOR
825
ba096dc4 826Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
16dc9970 827
828=head1 SEE ALSO
829
ba096dc4 830SQL::Translator, DDL::Oracle, mysql2ora.
16dc9970 831
832=cut
DDL Tool (dbsrgits@git.shadowcat.co.uk:SQL-Translator.git)