1 package SQL::Translator::Producer::DB2;
3 # -------------------------------------------------------------------
4 # $Id: DB2.pm,v 1.3 2006-06-07 16:02:54 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.3 $ =~ /(\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)
55 my %dt_translate = ( );
62 mediumint => 'integer',
63 tinyint => 'smallint',
67 longblob => 'long varchar for bit data',
68 tinytext => 'varchar',
70 longtext => 'varchar',
71 mediumtext => 'varchar',
75 datetime => 'timestamp',
82 'double precision' => 'double',
84 bigserial => 'integer',
87 'character varying' => 'varchar',
89 interval => 'integer',
90 boolean => 'smallint',
100 macaddr => 'varchar',
102 'bit varying' => 'number',
108 varchar2 => 'varchar',
113 my %db2_reserved = map { $_ => 1} qw/
114 ADD DETERMINISTIC LEAVE RESTART
115 AFTER DISALLOW LEFT RESTRICT
116 ALIAS DISCONNECT LIKE RESULT
117 ALL DISTINCT LINKTYPE RESULT_SET_LOCATOR
118 ALLOCATE DO LOCAL RETURN
119 ALLOW DOUBLE LOCALE RETURNS
120 ALTER DROP LOCATOR REVOKE
121 AND DSNHATTR LOCATORS RIGHT
122 ANY DSSIZE LOCK ROLLBACK
123 APPLICATION DYNAMIC LOCKMAX ROUTINE
125 ASSOCIATE EDITPROC LONG ROWS
126 ASUTIME ELSE LOOP RRN
127 AUDIT ELSEIF MAXVALUE RUN
128 AUTHORIZATION ENCODING MICROSECOND SAVEPOINT
129 AUX END MICROSECONDS SCHEMA
130 AUXILIARY END-EXEC MINUTE SCRATCHPAD
131 BEFORE END-EXEC1 MINUTES SECOND
132 BEGIN ERASE MINVALUE SECONDS
133 BETWEEN ESCAPE MODE SECQTY
134 BINARY EXCEPT MODIFIES SECURITY
135 BUFFERPOOL EXCEPTION MONTH SELECT
136 BY EXCLUDING MONTHS SENSITIVE
137 CACHE EXECUTE NEW SET
138 CALL EXISTS NEW_TABLE SIGNAL
139 CALLED EXIT NO SIMPLE
140 CAPTURE EXTERNAL NOCACHE SOME
141 CARDINALITY FENCED NOCYCLE SOURCE
142 CASCADED FETCH NODENAME SPECIFIC
143 CASE FIELDPROC NODENUMBER SQL
144 CAST FILE NOMAXVALUE SQLID
145 CCSID FINAL NOMINVALUE STANDARD
146 CHAR FOR NOORDER START
147 CHARACTER FOREIGN NOT STATIC
149 CLOSE FROM NULLS STOGROUP
150 CLUSTER FULL NUMPARTS STORES
151 COLLECTION FUNCTION OBID STYLE
152 COLLID GENERAL OF SUBPAGES
153 COLUMN GENERATED OLD SUBSTRING
154 COMMENT GET OLD_TABLE SYNONYM
155 COMMIT GLOBAL ON SYSFUN
156 CONCAT GO OPEN SYSIBM
157 CONDITION GOTO OPTIMIZATION SYSPROC
158 CONNECT GRANT OPTIMIZE SYSTEM
159 CONNECTION GRAPHIC OPTION TABLE
160 CONSTRAINT GROUP OR TABLESPACE
161 CONTAINS HANDLER ORDER THEN
162 CONTINUE HAVING OUT TO
163 COUNT HOLD OUTER TRANSACTION
164 COUNT_BIG HOUR OVERRIDING TRIGGER
165 CREATE HOURS PACKAGE TRIM
166 CROSS IDENTITY PARAMETER TYPE
168 CURRENT_DATE IMMEDIATE PARTITION UNION
169 CURRENT_LC_CTYPE IN PATH UNIQUE
170 CURRENT_PATH INCLUDING PIECESIZE UNTIL
171 CURRENT_SERVER INCREMENT PLAN UPDATE
172 CURRENT_TIME INDEX POSITION USAGE
173 CURRENT_TIMESTAMP INDICATOR PRECISION USER
174 CURRENT_TIMEZONE INHERIT PREPARE USING
175 CURRENT_USER INNER PRIMARY VALIDPROC
176 CURSOR INOUT PRIQTY VALUES
177 CYCLE INSENSITIVE PRIVILEGES VARIABLE
178 DATA INSERT PROCEDURE VARIANT
179 DATABASE INTEGRITY PROGRAM VCAT
181 DAYS IS QUERYNO VOLUMES
182 DB2GENERAL ISOBID READ WHEN
183 DB2GENRL ISOLATION READS WHERE
184 DB2SQL ITERATE RECOVERY WHILE
185 DBINFO JAR REFERENCES WITH
186 DECLARE JAVA REFERENCING WLM
187 DEFAULT JOIN RELEASE WRITE
188 DEFAULTS KEY RENAME YEAR
189 DEFINITION LABEL REPEAT YEARS
190 DELETE LANGUAGE RESET
191 DESCRIPTOR LC_CTYPE RESIGNAL
194 #------------------------------------------------------------------------------
198 my ($translator) = @_;
199 $DEBUG = $translator->debug;
200 $WARN = $translator->show_warnings;
201 my $no_comments = $translator->no_comments;
202 my $add_drop_table = $translator->add_drop_table;
203 my $schema = $translator->schema;
207 $output .= header_comment unless($no_comments);
208 my (@table_defs, @index_defs);
209 foreach my $table ($schema->get_tables)
211 push @table_defs, 'DROP TABLE ' . $table->name . ";" if $add_drop_table;
212 push @table_defs, create_table($table, {
213 no_comments => $no_comments});
215 foreach my $index ($table->get_indices)
217 push @index_defs, create_index($index);
222 foreach my $view ( $schema->get_views )
224 push @view_defs, create_view($view);
227 foreach my $trigger ( $schema->get_triggers )
229 push @trigger_defs, create_trigger($trigger);
232 return wantarray ? (@table_defs, @index_defs, @view_defs, @trigger_defs) :
233 $output . join("\n\n", @table_defs, @index_defs, @view_defs, @trigger_defs) . "\n";
240 my ($name, $type, $length) = @_;
243 if(length($name) > $length) ## Maximum table name length is 18
245 warn "Table name $name is longer than $length characters, truncated" if $WARN;
246 # if(grep {$_ eq substr($name, 0, $length) }
247 # values(%{$objnames{$type}}))
249 # die "Got multiple matching table names when truncated";
251 # $objnames{$type}{$name} = substr($name, 0,$length);
252 # $newname = $objnames{$type}{$name};
255 if($db2_reserved{uc($newname)})
257 warn "$newname is a reserved word in DB2!" if $WARN;
260 # return sprintf("%-*s", $length-5, $newname);
267 my ($table, $options) = @_;
269 my $table_name = check_name($table->name, 'tables', 128);
270 # this limit is 18 in older DB2s ! (<= 8)
272 my (@field_defs, @comments);
273 push @comments, "--\n-- Table: $table_name\n--" unless $options->{no_comments};
274 foreach my $field ($table->get_fields)
276 push @field_defs, create_field($field);
279 foreach my $con ($table->get_constraints)
281 push @con_defs, create_constraint($con);
283 my $pkey = join(", ", $table->primary_key()->fields);
285 my $tablespace = $table->extra()->{'TABLESPACE'} || '';
286 my $table_def = "CREATE TABLE $table_name (\n";
287 $table_def .= join (",\n", @field_defs);
288 $table_def .= join (",\n", @con_defs);
289 $table_def .= ",\n PRIMARY KEY($pkey)";
291 $table_def .= $tablespace ? "IN $tablespace;" : ';';
300 my $field_name = check_name($field->name, 'fields', 30);
302 # print Dumper(\%dt_translate);
303 # print $field->data_type, " ", $dt_translate{lc($field->data_type)}, "\n";
304 my $data_type = uc($dt_translate{lc($field->data_type)} || $field->data_type);
305 my $size = $field->size();
307 my $field_def = "$field_name $data_type";
308 $field_def .= $field->is_auto_increment ?
309 ' GENERATED BY DEFAULT AS IDENTITY' : '';
310 $field_def .= $data_type =~ /CHAR/i ? "(${size})" : '';
311 $field_def .= !$field->is_nullable ? ' NOT NULL':'';
312 # $field_def .= $field->is_primary_key ? ' PRIMARY KEY':'';
313 $field_def .= !defined $field->default_value ? '' :
314 $field->default_value =~ /current( |_)timestamp/i ||
315 $field->default_value =~ /\Qnow()\E/i ?
316 'DEFAULT CURRENT TIMESTAMP' : defined $field->default_value ?
317 (" DEFAULT '" . $field->default_value . "'") : '';
326 my $out = sprintf('CREATE %sINDEX %s ON %s ( %s );',
327 $index->type() =~ /^UNIQUE$/i ? 'UNIQUE' : '',
330 join(', ', $index->fields) );
335 sub create_constraint
337 my ($constraint) = @_;
339 return '' if($constraint->type =~ /^PRIMARY(_|\s)KEY$/i);
341 my $ctype = $constraint->type =~ /^PRIMARY(_|\s)KEY$/i ? 'PRIMARY KEY' :
342 $constraint->type =~ /^UNIQUE$/i ? 'UNIQUE' :
343 $constraint->type =~ /^CHECK_C$/i ? 'CHECK' :
344 $constraint->type =~ /^FOREIGN_KEY$/i ? 'FOREIGN KEY' : '';
346 my $expr = $constraint->type =~ /^CHECK_C$/i ? $constraint->expression :
348 my $ref = $constraint->type =~ /^FOREIGN_KEY$/i ? ('REFERENCES ' . $constraint->reference_table . '(' . join(', ', $constraint->reference_fields) . ')') : '';
349 my $update = $constraint->on_update ? $constraint->on_update : '';
350 my $delete = $constraint->on_delete ? $constraint->on_delete : '';
352 my $out = sprintf('%s %s %s %s %s %s',
353 $constraint->name ? ('CONSTRAINT ' . $constraint->name) : '',
355 '(' . join (', ', $constraint->fields) . ')',
356 $expr ? $expr : $ref,
369 my $out = sprintf("CREATE VIEW %s AS\n%s;",
379 # create: CREATE TRIGGER trigger_name before type /ON/i table_name reference_b(?) /FOR EACH ROW/i 'MODE DB2SQL' triggered_action
381 my $out = sprintf('CREATE TRIGGER %s %s %s ON %s %s %s MODE DB2SQL %s',
383 $trigger->perform_action_when || 'AFTER',
384 $trigger->database_event =~ /update_on/i ?
385 ('UPDATE OF '. join(', ', $trigger->fields)) :
386 $trigger->database_event || 'UPDATE',
387 $trigger->table->name,
388 $trigger->extra->{reference} || 'REFERENCING OLD AS oldrow NEW AS newrow',
389 $trigger->extra->{granularity} || 'FOR EACH ROW',
398 my ($from_field, $to_field) = @_;
400 my $data_type = uc($dt_translate{lc($to_field->data_type)} || $to_field->data_type);
402 my $size = $to_field->size();
403 $data_type .= $data_type =~ /CHAR/i ? "(${size})" : '';
405 # DB2 will only allow changing of varchar/vargraphic datatypes
406 # to extend their lengths. Or changing of text types to other
407 # texttypes, and numeric types to larger numeric types. (v8)
408 # We can also drop/add keys, checks and constraints, but not
411 my $out = sprintf('ALTER TABLE %s ALTER %s SET DATATYPE %s',
412 $to_field->table->name,
420 my ($new_field) = @_;
422 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
423 $new_field->table->name,
424 create_field($new_field));