1 package SQL::Translator::Producer::DB2;
3 # -------------------------------------------------------------------
4 # $Id: DB2.pm,v 1.2 2006-05-24 22:06:56 schiffbruechige Exp $
5 # -------------------------------------------------------------------
6 # Copyright (C) 2002-4 SQLFairy Authors
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.
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.
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
21 # -------------------------------------------------------------------
24 SQL::Translator::Producer::DB2 - DB2 SQL producer
30 my $t = SQL::Translator->new( parser => '...', producer => 'DB2' );
31 print $translator->translate( $file );
35 Creates an SQL DDL suitable for DB2.
41 use vars qw[ $VERSION $DEBUG $WARN ];
42 $VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
43 $DEBUG = 0 unless defined $DEBUG;
45 use SQL::Translator::Schema::Constants;
46 use SQL::Translator::Utils qw(header_comment);
49 # http://publib.boulder.ibm.com/infocenter/db2help/topic/com.ibm.db2.udb.doc/ad/r0006844.htm
51 # This is a terrible WTDI, each Parser should parse down to some standard set
52 # of SQL data types, with field->extra entries being used to convert back to
53 # weird types like "polygon" if needed (IMO anyway)
60 mediumint => 'integer',
61 tinyint => 'smallint',
65 longblob => 'long varchar for bit data',
66 tinytext => 'varchar',
68 longtext => 'varchar',
69 mediumtext => 'varchar',
73 datetime => 'timestamp',
80 'double precision' => 'double',
82 bigserial => 'integer',
85 'character varying' => 'varchar',
87 interval => 'integer',
88 boolean => 'smallint',
100 'bit varying' => 'number',
106 varchar2 => 'varchar',
110 my %db2_reserved = map { $_ => 1} qw/
111 ADD DETERMINISTIC LEAVE RESTART
112 AFTER DISALLOW LEFT RESTRICT
113 ALIAS DISCONNECT LIKE RESULT
114 ALL DISTINCT LINKTYPE RESULT_SET_LOCATOR
115 ALLOCATE DO LOCAL RETURN
116 ALLOW DOUBLE LOCALE RETURNS
117 ALTER DROP LOCATOR REVOKE
118 AND DSNHATTR LOCATORS RIGHT
119 ANY DSSIZE LOCK ROLLBACK
120 APPLICATION DYNAMIC LOCKMAX ROUTINE
122 ASSOCIATE EDITPROC LONG ROWS
123 ASUTIME ELSE LOOP RRN
124 AUDIT ELSEIF MAXVALUE RUN
125 AUTHORIZATION ENCODING MICROSECOND SAVEPOINT
126 AUX END MICROSECONDS SCHEMA
127 AUXILIARY END-EXEC MINUTE SCRATCHPAD
128 BEFORE END-EXEC1 MINUTES SECOND
129 BEGIN ERASE MINVALUE SECONDS
130 BETWEEN ESCAPE MODE SECQTY
131 BINARY EXCEPT MODIFIES SECURITY
132 BUFFERPOOL EXCEPTION MONTH SELECT
133 BY EXCLUDING MONTHS SENSITIVE
134 CACHE EXECUTE NEW SET
135 CALL EXISTS NEW_TABLE SIGNAL
136 CALLED EXIT NO SIMPLE
137 CAPTURE EXTERNAL NOCACHE SOME
138 CARDINALITY FENCED NOCYCLE SOURCE
139 CASCADED FETCH NODENAME SPECIFIC
140 CASE FIELDPROC NODENUMBER SQL
141 CAST FILE NOMAXVALUE SQLID
142 CCSID FINAL NOMINVALUE STANDARD
143 CHAR FOR NOORDER START
144 CHARACTER FOREIGN NOT STATIC
146 CLOSE FROM NULLS STOGROUP
147 CLUSTER FULL NUMPARTS STORES
148 COLLECTION FUNCTION OBID STYLE
149 COLLID GENERAL OF SUBPAGES
150 COLUMN GENERATED OLD SUBSTRING
151 COMMENT GET OLD_TABLE SYNONYM
152 COMMIT GLOBAL ON SYSFUN
153 CONCAT GO OPEN SYSIBM
154 CONDITION GOTO OPTIMIZATION SYSPROC
155 CONNECT GRANT OPTIMIZE SYSTEM
156 CONNECTION GRAPHIC OPTION TABLE
157 CONSTRAINT GROUP OR TABLESPACE
158 CONTAINS HANDLER ORDER THEN
159 CONTINUE HAVING OUT TO
160 COUNT HOLD OUTER TRANSACTION
161 COUNT_BIG HOUR OVERRIDING TRIGGER
162 CREATE HOURS PACKAGE TRIM
163 CROSS IDENTITY PARAMETER TYPE
165 CURRENT_DATE IMMEDIATE PARTITION UNION
166 CURRENT_LC_CTYPE IN PATH UNIQUE
167 CURRENT_PATH INCLUDING PIECESIZE UNTIL
168 CURRENT_SERVER INCREMENT PLAN UPDATE
169 CURRENT_TIME INDEX POSITION USAGE
170 CURRENT_TIMESTAMP INDICATOR PRECISION USER
171 CURRENT_TIMEZONE INHERIT PREPARE USING
172 CURRENT_USER INNER PRIMARY VALIDPROC
173 CURSOR INOUT PRIQTY VALUES
174 CYCLE INSENSITIVE PRIVILEGES VARIABLE
175 DATA INSERT PROCEDURE VARIANT
176 DATABASE INTEGRITY PROGRAM VCAT
178 DAYS IS QUERYNO VOLUMES
179 DB2GENERAL ISOBID READ WHEN
180 DB2GENRL ISOLATION READS WHERE
181 DB2SQL ITERATE RECOVERY WHILE
182 DBINFO JAR REFERENCES WITH
183 DECLARE JAVA REFERENCING WLM
184 DEFAULT JOIN RELEASE WRITE
185 DEFAULTS KEY RENAME YEAR
186 DEFINITION LABEL REPEAT YEARS
187 DELETE LANGUAGE RESET
188 DESCRIPTOR LC_CTYPE RESIGNAL
191 #------------------------------------------------------------------------------
195 my ($translator) = @_;
196 $DEBUG = $translator->debug;
197 $WARN = $translator->show_warnings;
198 my $no_comments = $translator->no_comments;
199 my $add_drop_table = $translator->add_drop_table;
200 my $schema = $translator->schema;
204 $output .= header_comment unless($no_comments);
205 my (@table_defs, @index_defs);
206 foreach my $table ($schema->get_tables)
208 push @table_defs, 'DROP TABLE ' . $table->name . ";\n" if $add_drop_table;
209 push @table_defs, create_table($table, {
210 no_comments => $no_comments});
212 foreach my $index ($table->get_indices)
214 push @index_defs, create_index($index);
219 foreach my $view ( $schema->get_views )
221 push @view_defs, create_view($view);
224 foreach my $trigger ( $schema->get_triggers )
226 push @trigger_defs, create_trigger($trigger);
229 $output .= join("\n\n", @table_defs, @index_defs, @view_defs, @trigger_defs) . "\n";
236 my ($name, $type, $length) = @_;
239 if(length($name) > $length) ## Maximum table name length is 18
241 warn "Table name $name is longer than $length characters, truncated" if $WARN;
242 # if(grep {$_ eq substr($name, 0, $length) }
243 # values(%{$objnames{$type}}))
245 # die "Got multiple matching table names when truncated";
247 # $objnames{$type}{$name} = substr($name, 0,$length);
248 # $newname = $objnames{$type}{$name};
251 if($db2_reserved{uc($newname)})
253 warn "$newname is a reserved word in DB2!" if $WARN;
256 return sprintf("%-*s", $length-5, $newname);
262 my ($table, $options) = @_;
264 my $table_name = check_name($table->name, 'tables', 128);
265 # this limit is 18 in older DB2s ! (<= 8)
267 my (@field_defs, @comments);
268 push @comments, "--\n-- Table: $table_name\n--" unless $options->{no_comments};
269 foreach my $field ($table->get_fields)
271 push @field_defs, create_field($field);
274 foreach my $con ($table->get_constraints)
276 push @con_defs, create_constraint($con);
278 my $pkey = join(", ", $table->primary_key()->fields);
280 my $tablespace = $table->extra()->{'TABLESPACE'} || '';
281 my $table_def = "CREATE TABLE $table_name (\n";
282 $table_def .= join (",\n", @field_defs);
283 $table_def .= join (",\n", @con_defs);
284 $table_def .= ",\n PRIMARY KEY($pkey)";
286 $table_def .= $tablespace ? "IN $tablespace;" : ';';
295 my $field_name = check_name($field->name, 'fields', 30);
297 # print Dumper(\%dt_translate);
298 # print $field->data_type, " ", $dt_translate{lc($field->data_type)}, "\n";
299 my $data_type = uc($dt_translate{lc($field->data_type)} || $field->data_type);
300 my $size = $field->size();
302 my $field_def = "$field_name $data_type";
303 $field_def .= $field->is_auto_increment ?
304 ' GENERATED BY DEFAULT AS IDENTITY' : '';
305 $field_def .= $data_type =~ /CHAR/i ? "(${size})" : '';
306 $field_def .= !$field->is_nullable ? ' NOT NULL':'';
307 # $field_def .= $field->is_primary_key ? ' PRIMARY KEY':'';
308 $field_def .= !defined $field->default_value ? '' :
309 $field->default_value =~ /current( |_)timestamp/i ||
310 $field->default_value =~ /\Qnow()\E/i ?
311 'DEFAULT CURRENT TIMESTAMP' : defined $field->default_value ?
312 (" DEFAULT '" . $field->default_value . "'") : '';
320 my $out = sprintf('CREATE %sINDEX %s ON %s ( %s );',
321 $index->type() =~ /^UNIQUE$/i ? 'UNIQUE' : '',
324 join(', ', $index->fields) );
329 sub create_constraint
331 my ($constraint) = @_;
333 return '' if($constraint->type =~ /^PRIMARY(_|\s)KEY$/i);
335 my $ctype = $constraint->type =~ /^PRIMARY(_|\s)KEY$/i ? 'PRIMARY KEY' :
336 $constraint->type =~ /^UNIQUE$/i ? 'UNIQUE' :
337 $constraint->type =~ /^CHECK_C$/i ? 'CHECK' :
338 $constraint->type =~ /^FOREIGN_KEY$/i ? 'FOREIGN KEY' : '';
340 my $expr = $constraint->type =~ /^CHECK_C$/i ? $constraint->expression :
342 my $ref = $constraint->type =~ /^FOREIGN_KEY$/i ? ('REFERENCES ' . $constraint->reference_table . '(' . join(', ', $constraint->reference_fields) . ')') : '';
343 my $update = $constraint->on_update ? $constraint->on_update : '';
344 my $delete = $constraint->on_delete ? $constraint->on_delete : '';
346 my $out = sprintf('%s %s %s %s %s %s',
347 $constraint->name ? ('CONSTRAINT ' . $constraint->name) : '',
349 '(' . join (', ', $constraint->fields) . ')',
350 $expr ? $expr : $ref,
363 my $out = sprintf("CREATE VIEW %s AS\n%s;",
373 # create: CREATE TRIGGER trigger_name before type /ON/i table_name reference_b(?) /FOR EACH ROW/i 'MODE DB2SQL' triggered_action
375 my $out = sprintf('CREATE TRIGGER %s %s %s ON %s %s %s MODE DB2SQL %s',
377 $trigger->perform_action_when || 'AFTER',
378 $trigger->database_event =~ /update_on/i ?
379 ('UPDATE OF '. join(', ', $trigger->fields)) :
380 $trigger->database_event || 'UPDATE',
381 $trigger->on_table->name,
382 $trigger->extra->{reference} || 'REFERENCING OLD AS oldrow NEW AS newrow',
383 $trigger->extra->{granularity} || 'FOR EACH ROW',
392 my ($from_field, $to_field) = @_;