1 package SQL::Translator::Producer::DB2;
5 SQL::Translator::Producer::DB2 - DB2 SQL producer
11 my $t = SQL::Translator->new( parser => '...', producer => 'DB2' );
12 print $translator->translate( $file );
16 Creates an SQL DDL suitable for DB2.
23 use vars qw[ $VERSION $DEBUG $WARN ];
25 $DEBUG = 0 unless defined $DEBUG;
27 use SQL::Translator::Schema::Constants;
28 use SQL::Translator::Utils qw(header_comment);
31 # http://publib.boulder.ibm.com/infocenter/db2help/topic/com.ibm.db2.udb.doc/ad/r0006844.htm
33 # This is a terrible WTDI, each Parser should parse down to some standard set
34 # of SQL data types, with field->extra entries being used to convert back to
35 # weird types like "polygon" if needed (IMO anyway)
44 mediumint => 'integer',
45 tinyint => 'smallint',
49 longblob => 'long varchar for bit data',
50 tinytext => 'varchar',
52 longtext => 'varchar',
53 mediumtext => 'varchar',
57 datetime => 'timestamp',
64 'double precision' => 'double',
66 bigserial => 'integer',
69 'character varying' => 'varchar',
71 interval => 'integer',
72 boolean => 'smallint',
84 'bit varying' => 'number',
90 varchar2 => 'varchar',
95 my %db2_reserved = map { $_ => 1} qw/
96 ADD DETERMINISTIC LEAVE RESTART
97 AFTER DISALLOW LEFT RESTRICT
98 ALIAS DISCONNECT LIKE RESULT
99 ALL DISTINCT LINKTYPE RESULT_SET_LOCATOR
100 ALLOCATE DO LOCAL RETURN
101 ALLOW DOUBLE LOCALE RETURNS
102 ALTER DROP LOCATOR REVOKE
103 AND DSNHATTR LOCATORS RIGHT
104 ANY DSSIZE LOCK ROLLBACK
105 APPLICATION DYNAMIC LOCKMAX ROUTINE
107 ASSOCIATE EDITPROC LONG ROWS
108 ASUTIME ELSE LOOP RRN
109 AUDIT ELSEIF MAXVALUE RUN
110 AUTHORIZATION ENCODING MICROSECOND SAVEPOINT
111 AUX END MICROSECONDS SCHEMA
112 AUXILIARY END-EXEC MINUTE SCRATCHPAD
113 BEFORE END-EXEC1 MINUTES SECOND
114 BEGIN ERASE MINVALUE SECONDS
115 BETWEEN ESCAPE MODE SECQTY
116 BINARY EXCEPT MODIFIES SECURITY
117 BUFFERPOOL EXCEPTION MONTH SELECT
118 BY EXCLUDING MONTHS SENSITIVE
119 CACHE EXECUTE NEW SET
120 CALL EXISTS NEW_TABLE SIGNAL
121 CALLED EXIT NO SIMPLE
122 CAPTURE EXTERNAL NOCACHE SOME
123 CARDINALITY FENCED NOCYCLE SOURCE
124 CASCADED FETCH NODENAME SPECIFIC
125 CASE FIELDPROC NODENUMBER SQL
126 CAST FILE NOMAXVALUE SQLID
127 CCSID FINAL NOMINVALUE STANDARD
128 CHAR FOR NOORDER START
129 CHARACTER FOREIGN NOT STATIC
131 CLOSE FROM NULLS STOGROUP
132 CLUSTER FULL NUMPARTS STORES
133 COLLECTION FUNCTION OBID STYLE
134 COLLID GENERAL OF SUBPAGES
135 COLUMN GENERATED OLD SUBSTRING
136 COMMENT GET OLD_TABLE SYNONYM
137 COMMIT GLOBAL ON SYSFUN
138 CONCAT GO OPEN SYSIBM
139 CONDITION GOTO OPTIMIZATION SYSPROC
140 CONNECT GRANT OPTIMIZE SYSTEM
141 CONNECTION GRAPHIC OPTION TABLE
142 CONSTRAINT GROUP OR TABLESPACE
143 CONTAINS HANDLER ORDER THEN
144 CONTINUE HAVING OUT TO
145 COUNT HOLD OUTER TRANSACTION
146 COUNT_BIG HOUR OVERRIDING TRIGGER
147 CREATE HOURS PACKAGE TRIM
148 CROSS IDENTITY PARAMETER TYPE
150 CURRENT_DATE IMMEDIATE PARTITION UNION
151 CURRENT_LC_CTYPE IN PATH UNIQUE
152 CURRENT_PATH INCLUDING PIECESIZE UNTIL
153 CURRENT_SERVER INCREMENT PLAN UPDATE
154 CURRENT_TIME INDEX POSITION USAGE
155 CURRENT_TIMESTAMP INDICATOR PRECISION USER
156 CURRENT_TIMEZONE INHERIT PREPARE USING
157 CURRENT_USER INNER PRIMARY VALIDPROC
158 CURSOR INOUT PRIQTY VALUES
159 CYCLE INSENSITIVE PRIVILEGES VARIABLE
160 DATA INSERT PROCEDURE VARIANT
161 DATABASE INTEGRITY PROGRAM VCAT
163 DAYS IS QUERYNO VOLUMES
164 DB2GENERAL ISOBID READ WHEN
165 DB2GENRL ISOLATION READS WHERE
166 DB2SQL ITERATE RECOVERY WHILE
167 DBINFO JAR REFERENCES WITH
168 DECLARE JAVA REFERENCING WLM
169 DEFAULT JOIN RELEASE WRITE
170 DEFAULTS KEY RENAME YEAR
171 DEFINITION LABEL REPEAT YEARS
172 DELETE LANGUAGE RESET
173 DESCRIPTOR LC_CTYPE RESIGNAL
178 my ($translator) = @_;
179 $DEBUG = $translator->debug;
180 $WARN = $translator->show_warnings;
181 my $no_comments = $translator->no_comments;
182 my $add_drop_table = $translator->add_drop_table;
183 my $schema = $translator->schema;
187 $output .= header_comment unless($no_comments);
188 my (@table_defs, @fks, @index_defs);
189 foreach my $table ($schema->get_tables)
191 push @table_defs, 'DROP TABLE ' . $table->name . ";" if $add_drop_table;
192 my ($table_def, $fks) = create_table($table, {
193 no_comments => $no_comments});
194 push @table_defs, $table_def;
197 foreach my $index ($table->get_indices)
199 push @index_defs, create_index($index);
204 foreach my $view ( $schema->get_views )
206 push @view_defs, create_view($view);
209 foreach my $trigger ( $schema->get_triggers )
211 push @trigger_defs, create_trigger($trigger);
214 return wantarray ? (@table_defs, @fks, @index_defs, @view_defs, @trigger_defs) :
215 $output . join("\n\n", @table_defs, @fks, @index_defs, @view_defs, @trigger_defs) . "\n";
222 my ($name, $type, $length) = @_;
225 if(length($name) > $length) ## Maximum table name length is 18
227 warn "Table name $name is longer than $length characters, truncated" if $WARN;
228 # if(grep {$_ eq substr($name, 0, $length) }
229 # values(%{$objnames{$type}}))
231 # die "Got multiple matching table names when truncated";
233 # $objnames{$type}{$name} = substr($name, 0,$length);
234 # $newname = $objnames{$type}{$name};
237 if($db2_reserved{uc($newname)})
239 warn "$newname is a reserved word in DB2!" if $WARN;
242 # return sprintf("%-*s", $length-5, $newname);
249 my ($table, $options) = @_;
251 my $table_name = check_name($table->name, 'tables', 128);
252 # this limit is 18 in older DB2s ! (<= 8)
254 my (@field_defs, @comments);
255 push @comments, "--\n-- Table: $table_name\n--" unless $options->{no_comments};
256 foreach my $field ($table->get_fields)
258 push @field_defs, create_field($field);
260 my (@con_defs, @fks);
261 foreach my $con ($table->get_constraints)
263 my ($cdefs, $fks) = create_constraint($con);
264 push @con_defs, @$cdefs;
268 my $tablespace = $table->extra()->{'TABLESPACE'} || '';
269 my $table_def = "CREATE TABLE $table_name (\n";
270 $table_def .= join (",\n", map { " $_" } @field_defs, @con_defs);
272 $table_def .= $tablespace ? "IN $tablespace;" : ';';
274 return $table_def, \@fks;
281 my $field_name = check_name($field->name, 'fields', 30);
283 # print Dumper(\%dt_translate);
284 # print $field->data_type, " ", $dt_translate{lc($field->data_type)}, "\n";
285 my $data_type = uc($dt_translate{lc($field->data_type)} || $field->data_type);
286 my $size = $field->size();
288 my $field_def = "$field_name $data_type";
289 $field_def .= $field->is_auto_increment ?
290 ' GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1)' : '';
291 $field_def .= $data_type =~ /(CHAR|CLOB|NUMERIC|DECIMAL)/i ? "(${size})" : '';
292 $field_def .= !$field->is_nullable ? ' NOT NULL':'';
293 # $field_def .= $field->is_primary_key ? ' PRIMARY KEY':'';
294 $field_def .= !defined $field->default_value ? '' :
295 $field->default_value =~ /current( |_)timestamp/i ||
296 $field->default_value =~ /\Qnow()\E/i ?
297 ' DEFAULT CURRENT TIMESTAMP' : defined $field->default_value ?
298 (" DEFAULT " . ($data_type =~ /(INT|DOUBLE)/i ?
299 $field->default_value : "'" . $field->default_value . "'")
309 my $out = sprintf('CREATE %sINDEX %s ON %s ( %s );',
310 $index->type() =~ /^UNIQUE$/i ? 'UNIQUE' : '',
313 join(', ', $index->fields) );
318 sub create_constraint
320 my ($constraint) = @_;
322 my (@con_defs, @fks);
324 my $ctype = $constraint->type =~ /^PRIMARY(_|\s)KEY$/i ? 'PRIMARY KEY' :
325 $constraint->type =~ /^UNIQUE$/i ? 'UNIQUE' :
326 $constraint->type =~ /^CHECK_C$/i ? 'CHECK' :
327 $constraint->type =~ /^FOREIGN(_|\s)KEY$/i ? 'FOREIGN KEY' : '';
329 my $expr = $constraint->type =~ /^CHECK_C$/i ? $constraint->expression :
331 my $ref = $constraint->type =~ /^FOREIGN(_|\s)KEY$/i ? ('REFERENCES ' . $constraint->reference_table . '(' . join(', ', $constraint->reference_fields) . ')') : '';
332 my $update = $constraint->on_update ? $constraint->on_update : '';
333 my $delete = $constraint->on_delete ? $constraint->on_delete : '';
335 my $out = join(' ', grep { $_ }
336 $constraint->name ? ('CONSTRAINT ' . $constraint->name) : '',
338 '(' . join (', ', $constraint->fields) . ')',
339 $expr ? $expr : $ref,
342 if ($constraint->type eq FOREIGN_KEY) {
343 my $table_name = $constraint->table->name;
344 $out = "ALTER TABLE $table_name ADD $out;";
348 push @con_defs, $out;
351 return \@con_defs, \@fks;
359 my $out = sprintf("CREATE VIEW %s AS\n%s;",
369 # create: CREATE TRIGGER trigger_name before type /ON/i table_name reference_b(?) /FOR EACH ROW/i 'MODE DB2SQL' triggered_action
371 my $db_events = join ', ', $trigger->database_events;
372 my $out = sprintf('CREATE TRIGGER %s %s %s ON %s %s %s MODE DB2SQL %s',
374 $trigger->perform_action_when || 'AFTER',
375 $db_events =~ /update_on/i ?
376 ('UPDATE OF '. join(', ', $trigger->fields)) :
377 $db_events || 'UPDATE',
378 $trigger->table->name,
379 $trigger->extra->{reference} || 'REFERENCING OLD AS oldrow NEW AS newrow',
380 $trigger->extra->{granularity} || 'FOR EACH ROW',
389 my ($from_field, $to_field) = @_;
391 my $data_type = uc($dt_translate{lc($to_field->data_type)} || $to_field->data_type);
393 my $size = $to_field->size();
394 $data_type .= $data_type =~ /CHAR/i ? "(${size})" : '';
396 # DB2 will only allow changing of varchar/vargraphic datatypes
397 # to extend their lengths. Or changing of text types to other
398 # texttypes, and numeric types to larger numeric types. (v8)
399 # We can also drop/add keys, checks and constraints, but not
402 my $out = sprintf('ALTER TABLE %s ALTER %s SET DATATYPE %s',
403 $to_field->table->name,
411 my ($new_field) = @_;
413 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
414 $new_field->table->name,
415 create_field($new_field));