1 package SQL::Translator::Producer::Oracle;
3 # -------------------------------------------------------------------
4 # $Id: Oracle.pm,v 1.3 2002-11-20 04:03:04 kycl4rk Exp $
5 # -------------------------------------------------------------------
6 # Copyright (C) 2002 Ken Y. Clark <kycl4rk@users.sourceforge.net>,
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 # -------------------------------------------------------------------
26 use vars qw( $VERSION );
27 $VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/;
29 my $max_identifier_length = 30;
30 my %used_identifiers = ();
38 mediumint => 'number',
44 varchar => 'varchar2',
66 # This is for testing only, and probably needs to be removed
67 *translate = *produce;
70 my ( $translator, $data ) = @_;
72 #print "got ", scalar keys %$data, " tables:\n";
73 #print join(', ', keys %$data), "\n";
74 #print Dumper( $data );
79 my $output = sprintf "
81 # Created by %s, version %s
85 ", __PACKAGE__, $VERSION, $translator->parser_type;
88 # Print create for each table
90 my ( $index_i, $trigger_i ) = ( 1, 1 );
91 for my $table_name ( sort keys %$data ) {
92 check_identifier( $table_name );
94 my ( @comments, @field_decs, @trigger_decs );
96 my $table = $data->{ $table_name };
97 push @comments, "#\n# Table: $table_name\n#";
101 sort { $a->[0] <=> $b->[0] }
102 map { [ $_->{'order'}, $_ ] }
103 values %{ $table->{'fields'} }
108 my $field_str = check_identifier( $field->{'name'} );
113 my $data_type = $field->{'data_type'};
114 $data_type = defined $translate{ $data_type } ?
115 $translate{ $data_type } :
116 die "Unknown datatype: $data_type\n";
117 $field_str .= ' '.$data_type;
118 $field_str .= '('.$field->{'size'}.')' if defined $field->{'size'};
123 if ( $field->{'default'} ) {
124 # next if $field->{'default'} eq 'NULL';
125 $field_str .= sprintf(
127 $field->{'default'} =~ m/null/i ? 'NULL' :
128 "'".$field->{'default'}."'"
133 # Not null constraint
135 unless ( $field->{'null'} ) {
136 my $constraint_name = make_identifier($field->{'name'}, '_nn');
137 $field_str .= ' CONSTRAINT ' . $constraint_name . ' NOT NULL';
143 if ( $field->{'is_auto_inc'} ) {
144 my $trigger_no = $trigger_i++;
145 my $trigger_sequence =
146 join( '_', 'seq' , $field->{'name'}, $trigger_no );
148 join( '_', 'autoinc', $field->{'name'}, $trigger_no );
151 'CREATE SEQUENCE ' . $trigger_sequence . ";" .
152 'CREATE OR REPLACE TRIGGER ' . $trigger_name .
153 ' BEFORE INSERT ON ' . $table_name .
154 ' FOR EACH ROW WHEN (new.' . $field->{'name'} . ' is null) ' .
156 ' SELECT ' . $trigger_sequence . '.nextval ' .
157 ' INTO :new.' . $field->{'name'} .
159 ' END ' . $trigger_name . ";/"
163 push @field_decs, $field_str;
170 for my $index ( @{ $table->{'indices'} } ) {
171 my $index_name = $index->{'name'} || '';
172 my $index_type = $index->{'type'} || 'normal';
173 my @fields = @{ $index->{'fields'} } or next;
175 if ( $index_type eq 'primary_key' ) {
176 if ( !$index_name ) {
177 $index_name = make_identifier( $table_name, 'i_', '_pk' );
179 elsif ( $index_name !~ m/^i_/ ) {
180 $index_name = make_identifier( $table_name, 'i_' );
182 elsif ( $index_name !~ m/_pk$/ ) {
183 $index_name = make_identifier( $table_name, '_pk' );
186 $index_name = make_identifier( $index_name );
189 push @field_decs, 'CONSTRAINT ' . $index_name . ' PRIMARY KEY ' .
190 '(' . join( ', ', @fields ) . ')';
193 elsif ( $index_type eq 'unique' ) {
194 if ( !$index_name ) {
195 $index_name = make_identifier( join( '_', @fields ), 'u_' );
197 elsif ( $index_name !~ m/^u_/ ) {
198 $index_name = make_identifier( $index_name, 'u_' );
201 $index_name = make_identifier( $index_name );
204 push @field_decs, 'CONSTRAINT ' . $index_name . ' UNIQUE ' .
205 '(' . join( ', ', @fields ) . ')';
208 elsif ( $index_type eq 'normal' ) {
209 if ( !$index_name ) {
211 make_identifier($table_name, 'i_', '_'.$index_i++ );
213 elsif ( $index_name !~ m/^i_/ ) {
214 $index_name = make_identifier( $index_name, 'i_' );
217 $index_name = make_identifier( $index_name );
220 push @index_decs, "CREATE INDEX $index_name on $table_name (".
221 join( ', ', @{ $index->{'fields'} } ).
227 warn "On table $table_name, unknown index type: $index_type\n";
231 my $create_statement = "CREATE TABLE $table_name (\n".
232 join( ",\n", map { " $_" } @field_decs ).
236 $output .= join( "\n\n",
245 $output .= "#\n# End\n#\n";
249 # Used to make index names
251 sub make_identifier {
252 my ( $identifier, @mutations ) = @_;
253 my $length_of_mutations;
254 for my $mutation ( @mutations ) {
255 $length_of_mutations += length( $mutation );
259 length( $identifier ) + $length_of_mutations >
260 $max_identifier_length
262 $identifier = substr(
265 $max_identifier_length - $length_of_mutations
269 for my $mutation ( @mutations ) {
270 if ( $mutation =~ m/.+_$/ ) {
271 $identifier = $mutation.$identifier;
273 elsif ( $mutation =~ m/^_.+/ ) {
274 $identifier = $identifier.$mutation;
278 if ( $used_identifiers{ $identifier } ) {
280 if ( $identifier =~ m/_(\d+)$/ ) {
282 $identifier = substr(
285 length( $identifier ) - ( length( $index ) + 1 )
289 return make_identifier( $identifier, '_'.$index );
292 $used_identifiers{ $identifier } = 1;
298 # Checks to see if an identifier is not too long
300 sub check_identifier {
301 my $identifier = shift;
302 die "Identifier '$identifier' is too long, unrecoverable error.\n"
303 if length( $identifier ) > $max_identifier_length;
309 #-----------------------------------------------------
310 # All bad art is the result of good intentions.
312 #-----------------------------------------------------
316 SQL::Translator::Producer::Oracle - Oracle SQL producer
320 use SQL::Translator::Parser::MySQL;
321 use SQL::Translator::Producer::Oracle;
323 my $original_create = ""; # get this from somewhere...
324 my $translator = SQL::Translator->new;
326 $translator->parser("SQL::Translator::Parser::MySQL");
327 $translator->producer("SQL::Translator::Producer::Oracle");
329 my $new_create = $translator->translate($original_create);
333 SQL::Translator::Producer::Oracle takes a parsed data structure,
334 created by a SQL::Translator::Parser subclass, and turns it into a
335 create string suitable for use with an Oracle database.
339 Problem with SQL::Translator::Producer::Oracle: it is keeping track
340 of the last sequence number used, so as not to duplicate them, which
341 is reasonable. However on runs past the first, it seems to be
342 creating multiple constraint lines, that look like:
344 CONSTRAINT i_sessions_pk_2 PRIMARY KEY (id),
345 CONSTRAINT i_sessions_pk_3 PRIMARY KEY (id)
347 This is a very preliminary finding, and needs to be investigated more
348 thoroughly, of course.
353 Ken Y. Clark, kclark@logsoft.com