1 package SQL::Translator::Producer::Oracle;
3 # -------------------------------------------------------------------
4 # $Id: Oracle.pm,v 1.6 2002-11-26 03:59:58 kycl4rk Exp $
5 # -------------------------------------------------------------------
6 # Copyright (C) 2002 Ken Y. Clark <kclark@cpan.org>,
7 # darren chamberlain <darren@cpan.org>
9 # This program is free software; you can redistribute it and/or
10 # modify it under the terms of the GNU General Public License as
11 # published by the Free Software Foundation; version 2.
13 # This program is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 # General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with this program; if not, write to the Free Software
20 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
22 # -------------------------------------------------------------------
25 use vars qw[ $VERSION $DEBUG $WARN ];
26 $VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/;
27 $DEBUG = 0 unless defined $DEBUG;
38 mediumint => 'number',
42 varchar => 'varchar2',
68 'double precision' => '',
73 'character varying' => '',
92 # Oracle reserved words from:
93 # http://technet.oracle.com/docs/products/oracle8i/doc_library/\
94 # 817_doc/server.817/a85397/ap_keywd.htm
96 my %ora_reserved = map { $_, 1 } qw(
97 ACCESS ADD ALL ALTER AND ANY AS ASC AUDIT
99 CHAR CHECK CLUSTER COLUMN COMMENT COMPRESS CONNECT CREATE CURRENT
100 DATE DECIMAL DEFAULT DELETE DESC DISTINCT DROP
101 ELSE EXCLUSIVE EXISTS
105 IDENTIFIED IMMEDIATE IN INCREMENT INDEX INITIAL INSERT
106 INTEGER INTERSECT INTO IS
108 MAXEXTENTS MINUS MLSLABEL MODE MODIFY
109 NOAUDIT NOCOMPRESS NOT NOWAIT NULL NUMBER
110 OF OFFLINE ON ONLINE OPTION OR ORDER
111 PCTFREE PRIOR PRIVILEGES PUBLIC
112 RAW RENAME RESOURCE REVOKE ROW ROWID ROWNUM ROWS
113 SELECT SESSION SET SHARE SIZE SMALLINT START
114 SUCCESSFUL SYNONYM SYSDATE
115 TABLE THEN TO TRIGGER
116 UID UNION UNIQUE UPDATE USER
117 VALIDATE VALUES VARCHAR VARCHAR2 VIEW
121 my $max_id_length = 30;
122 my %used_identifiers = ();
127 # -------------------------------------------------------------------
129 my ( $translator, $data ) = @_;
130 $DEBUG = $translator->debug;
131 $WARN = $translator->show_warnings;
132 my $no_comments = $translator->no_comments;
133 my $add_drop_table = $translator->add_drop_table;
136 unless ( $no_comments ) {
138 "--\n-- Created by %s\n-- Created on %s\n--\n\n",
139 __PACKAGE__, scalar localtime;
142 if ( $translator->parser_type =~ /mysql/i ) {
144 "-- We assume that default NLS_DATE_FORMAT has been changed\n".
145 "-- but we set it here anyway to be self-consistent.\n".
146 "ALTER SESSION SET NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS';\n\n";
150 # Print create for each table
154 sort { $a->[0] <=> $b->[0] }
155 map { [ $_->{'order'}, $_ ] }
158 my $table_name = $table->{'table_name'};
159 $table_name = mk_name( $table_name, '', undef, 1 );
160 my $table_name_ur = unreserve($table_name);
162 my ( @comments, @field_decs, @trigger_decs );
164 push @comments, "--\n-- Table: $table_name_ur\n--" unless $no_comments;
166 my %field_name_scope;
169 sort { $a->[0] <=> $b->[0] }
170 map { [ $_->{'order'}, $_ ] }
171 values %{ $table->{'fields'} }
176 my $field_name = mk_name(
177 $field->{'name'}, '', \%field_name_scope, 1
179 my $field_name_ur = unreserve( $field_name, $table_name );
180 my $field_str = $field_name_ur;
186 my $data_type = lc $field->{'data_type'};
187 my $list = $field->{'list'} || [];
188 my $commalist = join ",", @$list;
190 if ( $data_type eq 'enum' ) {
192 $len = ($len < length($_)) ? length($_) : $len for (@$list);
193 $check = "CHECK ($field_name IN ($commalist))";
194 $field_str .= " varchar2($len)";
196 elsif ( $data_type eq 'set' ) {
197 # XXX add a CHECK constraint maybe
198 # (trickier and slower, than enum :)
199 my $len = length $commalist;
200 $field_str .= " varchar2($len) /* set $commalist */ ";
203 $data_type = defined $translate{ $data_type } ?
204 $translate{ $data_type } :
205 die "Unknown datatype: $data_type\n";
206 $field_str .= ' '.$data_type;
207 $field_str .= '('.join(',', @{ $field->{'size'} }).')'
208 if @{ $field->{'size'} || [] };
214 if ( $field->{'default'} ) {
215 $field_str .= sprintf(
217 $field->{'default'} =~ m/null/i ? 'NULL' :
218 "'".$field->{'default'}."'"
223 # Not null constraint
225 unless ( $field->{'null'} ) {
226 my $constraint_name = mk_name($field_name_ur, 'nn');
227 $field_str .= ' CONSTRAINT ' . $constraint_name . ' NOT NULL';
230 $field_str .= " $check" if $check;
235 if ( $field->{'is_auto_inc'} ) {
236 my $base_name = $table_name . "_". $field_name;
237 my $seq_name = mk_name( $base_name, 'sq' );
238 my $trigger_name = mk_name( $base_name, 'ai' );
241 "CREATE SEQUENCE $seq_name;\n" .
242 "CREATE OR REPLACE TRIGGER $trigger_name\n" .
243 "BEFORE INSERT ON $table_name\n" .
244 "FOR EACH ROW WHEN (\n" .
245 " new.$field_name_ur IS NULL".
246 " OR new.$field_name_ur = 0\n".
249 " SELECT $seq_name.nextval\n" .
250 " INTO :new." . $field->{'name'}."\n" .
256 if ( uc $field->{'data_type'} eq 'TIMESTAMP' ) {
257 my $base_name = $table_name . "_". $field_name_ur;
258 my $trig_name = mk_name( $base_name, 'ts' );
260 "CREATE OR REPLACE TRIGGER $trig_name\n".
261 "BEFORE INSERT OR UPDATE ON $table_name_ur\n".
262 "FOR EACH ROW WHEN (new.$field_name_ur} IS NULL)\n".
264 " SELECT sysdate INTO :new.$field_name_ur} FROM dual;\n".
268 push @field_decs, $field_str;
275 my $idx_name_default;
276 for my $index ( @{ $table->{'indices'} } ) {
277 my $index_name = $index->{'name'} || '';
278 my $index_type = $index->{'type'} || 'normal';
279 my @fields = map { unreserve( $_, $table_name ) }
280 @{ $index->{'fields'} };
283 if ( $index_type eq 'primary_key' ) {
284 $index_name = mk_name( $table_name, 'pk' );
285 push @field_decs, 'CONSTRAINT '.$index_name.' PRIMARY KEY '.
286 '(' . join( ', ', @fields ) . ')';
288 elsif ( $index_type eq 'unique' ) {
289 $index_name = mk_name(
290 $table_name, $index_name || ++$idx_name_default
292 push @field_decs, 'CONSTRAINT ' . $index_name . ' UNIQUE ' .
293 '(' . join( ', ', @fields ) . ')';
296 elsif ( $index_type eq 'normal' ) {
297 $index_name = mk_name(
298 $table_name, $index_name || ++$idx_name_default
300 push @index_decs, "CREATE INDEX $index_name on $table_name (".
301 join( ', ', @fields ). ");";
304 warn "Unknown index type ($index_type) on table $table_name.\n"
309 my $create_statement;
310 $create_statement = "DROP TABLE $table_name_ur;\n" if $add_drop_table;
311 $create_statement .= "CREATE TABLE $table_name_ur (\n".
312 join( ",\n", map { " $_" } @field_decs ).
316 $output .= join( "\n\n",
327 warn "Truncated " . keys( %truncated ) . " names:\n";
328 warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
332 warn "Encounted " . keys( %unreserve ) .
333 " unsafe names in schema (reserved or invalid):\n";
334 warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
341 # -------------------------------------------------------------------
343 my ($basename, $type, $scope, $critical) = @_;
344 my $basename_orig = $basename;
345 my $max_name = $max_id_length - (length($type) + 1);
346 $basename = substr( $basename, 0, $max_name )
347 if length( $basename ) > $max_name;
348 my $name = $type ? "${type}_$basename" : $basename;
350 if ( $basename ne $basename_orig and $critical ) {
351 my $show_type = $type ? "+'$type'" : "";
352 warn "Truncating '$basename_orig'$show_type to $max_id_length ",
353 "character limit to make '$name'\n" if $WARN;
354 $truncated{ $basename_orig } = $name;
357 $scope ||= \%global_names;
358 if ( my $prev = $scope->{ $name } ) {
359 my $name_orig = $name;
360 $name .= sprintf( "%02d", ++$prev );
361 substr($name, $max_id_length - 3) = "00"
362 if length( $name ) > $max_id_length;
364 warn "The name '$name_orig' has been changed to ",
365 "'$name' to make it unique.\n" if $WARN;
367 $scope->{ $name_orig }++;
374 # -------------------------------------------------------------------
376 my ( $name, $schema_obj_name ) = @_;
377 my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
379 # also trap fields that don't begin with a letter
380 return $_[0] if !$ora_reserved{ uc $name } && $name =~ /^[a-z]/i;
382 if ( $schema_obj_name ) {
383 ++$unreserve{"$schema_obj_name.$name"};
386 ++$unreserve{"$name (table name)"};
389 my $unreserve = sprintf '%s_', $name;
390 return $unreserve.$suffix;
395 # -------------------------------------------------------------------
396 # All bad art is the result of good intentions.
398 # -------------------------------------------------------------------
402 SQL::Translator::Producer::Oracle - Oracle SQL producer
406 use SQL::Translator::Parser::MySQL;
407 use SQL::Translator::Producer::Oracle;
409 my $original_create = ""; # get this from somewhere...
410 my $translator = SQL::Translator->new;
412 $translator->parser("SQL::Translator::Parser::MySQL");
413 $translator->producer("SQL::Translator::Producer::Oracle");
415 my $new_create = $translator->translate($original_create);
419 SQL::Translator::Producer::Oracle takes a parsed data structure,
420 created by a SQL::Translator::Parser subclass, and turns it into a
421 create string suitable for use with an Oracle database.
425 A hearty "thank-you" to Tim Bunce for much of the logic stolen from
426 his "mysql2ora" script.
430 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>