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