lib/SQL/Translator/Producer/DB2.pm

   1 package SQL::Translator::Producer::DB2;
   2
   3 =head1 NAME
   4
   5 SQL::Translator::Producer::DB2 - DB2 SQL producer
   6
   7 =head1 SYNOPSIS
   8
   9   use SQL::Translator;
  10
  11   my $t = SQL::Translator->new( parser => '...', producer => 'DB2' );
  12   print $translator->translate( $file );
  13
  14 =head1 DESCRIPTION
  15
  16 Creates an SQL DDL suitable for DB2.
  17
  18 =cut
  19
  20 use warnings;
  21 use strict;
  22 use vars qw[ $VERSION $DEBUG $WARN ];
  23 $VERSION = '1.59';
  24 $DEBUG   = 0 unless defined $DEBUG;
  25
  26 use SQL::Translator::Schema::Constants;
  27 use SQL::Translator::Utils qw(header_comment);
  28
  29
  30 # http://publib.boulder.ibm.com/infocenter/db2help/topic/com.ibm.db2.udb.doc/ad/r0006844.htm
  31
  32 # This is a terrible WTDI, each Parser should parse down to some standard set
  33 # of SQL data types, with field->extra entries being used to convert back to
  34 # weird types like "polygon" if needed (IMO anyway)
  35
  36 my %dt_translate;
  37 BEGIN {
  38   %dt_translate = (
  39     #
  40     # MySQL types
  41     #
  42     int        => 'integer',
  43     mediumint  => 'integer',
  44     tinyint    => 'smallint',
  45     char       => 'char',
  46     tinyblob   => 'blob',
  47     mediumblob => 'blob',
  48     longblob   => 'long varchar for bit data',
  49     tinytext   => 'varchar',
  50     text       => 'varchar',
  51     longtext   => 'varchar',
  52     mediumtext => 'varchar',
  53     enum       => 'varchar',
  54     set        => 'varchar',
  55     date       => 'date',
  56     datetime   => 'timestamp',
  57     time       => 'time',
  58     year       => 'date',
  59
  60     #
  61     # PostgreSQL types
  62     #
  63     'double precision'  => 'double',
  64     serial              => 'integer',
  65     bigserial           => 'integer',
  66     money               => 'double',
  67     character           => 'char',
  68     'character varying' => 'varchar',
  69     bytea               => 'BLOB',
  70     interval            => 'integer',
  71     boolean             => 'smallint',
  72     point               => 'integer',
  73     line                => 'integer',
  74     lseg                => 'integer',
  75     box                 => 'integer',
  76     path                => 'integer',
  77     polygon             => 'integer',
  78     circle              => 'integer',
  79     cidr                => 'integer',
  80     inet                => 'varchar',
  81     macaddr             => 'varchar',
  82     bit                 => 'number',
  83     'bit varying'       => 'number',
  84
  85     #
  86     # DB types
  87     #
  88     number              => 'integer',
  89     varchar2            => 'varchar',
  90     long                => 'clob',
  91 );
  92 }
  93
  94 my %db2_reserved = map { $_ => 1} qw/
  95 ADD                DETERMINISTIC  LEAVE         RESTART
  96 AFTER              DISALLOW       LEFT          RESTRICT
  97 ALIAS              DISCONNECT     LIKE          RESULT
  98 ALL                DISTINCT       LINKTYPE      RESULT_SET_LOCATOR
  99 ALLOCATE           DO             LOCAL         RETURN
 100 ALLOW              DOUBLE         LOCALE        RETURNS
 101 ALTER              DROP           LOCATOR       REVOKE
 102 AND                DSNHATTR       LOCATORS      RIGHT
 103 ANY                DSSIZE         LOCK          ROLLBACK
 104 APPLICATION        DYNAMIC        LOCKMAX       ROUTINE
 105 AS                 EACH           LOCKSIZE      ROW
 106 ASSOCIATE          EDITPROC       LONG          ROWS
 107 ASUTIME            ELSE           LOOP          RRN
 108 AUDIT              ELSEIF         MAXVALUE      RUN
 109 AUTHORIZATION      ENCODING       MICROSECOND   SAVEPOINT
 110 AUX                END            MICROSECONDS  SCHEMA
 111 AUXILIARY          END-EXEC       MINUTE        SCRATCHPAD
 112 BEFORE             END-EXEC1      MINUTES       SECOND
 113 BEGIN              ERASE          MINVALUE      SECONDS
 114 BETWEEN            ESCAPE         MODE          SECQTY
 115 BINARY             EXCEPT         MODIFIES      SECURITY
 116 BUFFERPOOL         EXCEPTION      MONTH         SELECT
 117 BY                 EXCLUDING      MONTHS        SENSITIVE
 118 CACHE              EXECUTE        NEW           SET
 119 CALL               EXISTS         NEW_TABLE     SIGNAL
 120 CALLED             EXIT           NO            SIMPLE
 121 CAPTURE            EXTERNAL       NOCACHE       SOME
 122 CARDINALITY        FENCED         NOCYCLE       SOURCE
 123 CASCADED           FETCH          NODENAME      SPECIFIC
 124 CASE               FIELDPROC      NODENUMBER    SQL
 125 CAST               FILE           NOMAXVALUE    SQLID
 126 CCSID              FINAL          NOMINVALUE    STANDARD
 127 CHAR               FOR            NOORDER       START
 128 CHARACTER          FOREIGN        NOT           STATIC
 129 CHECK              FREE           NULL          STAY
 130 CLOSE              FROM           NULLS         STOGROUP
 131 CLUSTER            FULL           NUMPARTS      STORES
 132 COLLECTION         FUNCTION       OBID          STYLE
 133 COLLID             GENERAL        OF            SUBPAGES
 134 COLUMN             GENERATED      OLD           SUBSTRING
 135 COMMENT            GET            OLD_TABLE     SYNONYM
 136 COMMIT             GLOBAL         ON            SYSFUN
 137 CONCAT             GO             OPEN          SYSIBM
 138 CONDITION          GOTO           OPTIMIZATION  SYSPROC
 139 CONNECT            GRANT          OPTIMIZE      SYSTEM
 140 CONNECTION         GRAPHIC        OPTION        TABLE
 141 CONSTRAINT         GROUP          OR            TABLESPACE
 142 CONTAINS           HANDLER        ORDER         THEN
 143 CONTINUE           HAVING         OUT           TO
 144 COUNT              HOLD           OUTER         TRANSACTION
 145 COUNT_BIG          HOUR           OVERRIDING    TRIGGER
 146 CREATE             HOURS          PACKAGE       TRIM
 147 CROSS              IDENTITY       PARAMETER     TYPE
 148 CURRENT            IF             PART          UNDO
 149 CURRENT_DATE       IMMEDIATE      PARTITION     UNION
 150 CURRENT_LC_CTYPE   IN             PATH          UNIQUE
 151 CURRENT_PATH       INCLUDING      PIECESIZE     UNTIL
 152 CURRENT_SERVER     INCREMENT      PLAN          UPDATE
 153 CURRENT_TIME       INDEX          POSITION      USAGE
 154 CURRENT_TIMESTAMP  INDICATOR      PRECISION     USER
 155 CURRENT_TIMEZONE   INHERIT        PREPARE       USING
 156 CURRENT_USER       INNER          PRIMARY       VALIDPROC
 157 CURSOR             INOUT          PRIQTY        VALUES
 158 CYCLE              INSENSITIVE    PRIVILEGES    VARIABLE
 159 DATA               INSERT         PROCEDURE     VARIANT
 160 DATABASE           INTEGRITY      PROGRAM       VCAT
 161 DAY                INTO           PSID          VIEW
 162 DAYS               IS             QUERYNO       VOLUMES
 163 DB2GENERAL         ISOBID         READ          WHEN
 164 DB2GENRL           ISOLATION      READS         WHERE
 165 DB2SQL             ITERATE        RECOVERY      WHILE
 166 DBINFO             JAR            REFERENCES    WITH
 167 DECLARE            JAVA           REFERENCING   WLM
 168 DEFAULT            JOIN           RELEASE       WRITE
 169 DEFAULTS           KEY            RENAME        YEAR
 170 DEFINITION         LABEL          REPEAT        YEARS
 171 DELETE             LANGUAGE       RESET
 172 DESCRIPTOR         LC_CTYPE       RESIGNAL
 173 /;
 174
 175 #------------------------------------------------------------------------------
 176
 177 sub produce
 178 {
 179     my ($translator) = @_;
 180     $DEBUG             = $translator->debug;
 181     $WARN              = $translator->show_warnings;
 182     my $no_comments    = $translator->no_comments;
 183     my $add_drop_table = $translator->add_drop_table;
 184     my $schema         = $translator->schema;
 185     my $output         = '';
 186     my $indent         = '    ';
 187
 188     $output .= header_comment unless($no_comments);
 189     my (@table_defs, @fks, @index_defs);
 190     foreach my $table ($schema->get_tables)
 191     {
 192         push @table_defs, 'DROP TABLE ' . $table->name . ";" if $add_drop_table;
 193         my ($table_def, $fks) = create_table($table, {
 194             no_comments => $no_comments});
 195         push @table_defs, $table_def;
 196         push @fks, @$fks;
 197
 198         foreach my $index ($table->get_indices)
 199         {
 200             push @index_defs, create_index($index);
 201         }
 202
 203     }
 204     my (@view_defs);
 205     foreach my $view ( $schema->get_views )
 206     {
 207         push @view_defs, create_view($view);
 208     }
 209     my (@trigger_defs);
 210     foreach my $trigger ( $schema->get_triggers )
 211     {
 212         push @trigger_defs, create_trigger($trigger);
 213     }
 214
 215     return wantarray ? (@table_defs, @fks, @index_defs, @view_defs, @trigger_defs) :
 216         $output . join("\n\n", @table_defs, @fks, @index_defs, @view_defs, @trigger_defs) . "\n";
 217 }
 218
 219 { my %objnames;
 220
 221     sub check_name
 222     {
 223         my ($name, $type, $length) = @_;
 224
 225         my $newname = $name;
 226         if(length($name) > $length)   ## Maximum table name length is 18
 227         {
 228             warn "Table name $name is longer than $length characters, truncated" if $WARN;
 229 #             if(grep {$_ eq substr($name, 0, $length) }
 230 #                               values(%{$objnames{$type}}))
 231 #             {
 232 #                 die "Got multiple matching table names when truncated";
 233 #             }
 234 #             $objnames{$type}{$name} = substr($name, 0,$length);
 235 #             $newname = $objnames{$type}{$name};
 236         }
 237
 238         if($db2_reserved{uc($newname)})
 239         {
 240             warn "$newname is a reserved word in DB2!" if $WARN;
 241         }
 242
 243 #        return sprintf("%-*s", $length-5, $newname);
 244         return $newname;
 245     }
 246 }
 247
 248 sub create_table
 249 {
 250     my ($table, $options) = @_;
 251
 252     my $table_name = check_name($table->name, 'tables', 128);
 253     # this limit is 18 in older DB2s ! (<= 8)
 254
 255     my (@field_defs, @comments);
 256     push @comments, "--\n-- Table: $table_name\n--" unless $options->{no_comments};
 257     foreach my $field ($table->get_fields)
 258     {
 259         push @field_defs, create_field($field);
 260     }
 261     my (@con_defs, @fks);
 262     foreach my $con ($table->get_constraints)
 263     {
 264         my ($cdefs, $fks) = create_constraint($con);
 265         push @con_defs, @$cdefs;
 266         push @fks, @$fks;
 267     }
 268
 269     my $tablespace = $table->extra()->{'TABLESPACE'} || '';
 270     my $table_def = "CREATE TABLE $table_name (\n";
 271     $table_def .= join (",\n", map { "  $_" } @field_defs, @con_defs);
 272     $table_def .= "\n)";
 273     $table_def .= $tablespace ? "IN $tablespace;" : ';';
 274
 275     return $table_def, \@fks;
 276 }
 277
 278 sub create_field
 279 {
 280     my ($field) = @_;
 281
 282     my $field_name = check_name($field->name, 'fields', 30);
 283 #    use Data::Dumper;
 284 #    print Dumper(\%dt_translate);
 285 #    print $field->data_type, " ", $dt_translate{lc($field->data_type)}, "\n";
 286     my $data_type = uc($dt_translate{lc($field->data_type)} || $field->data_type);
 287     my $size = $field->size();
 288
 289     my $field_def = "$field_name $data_type";
 290     $field_def .= $field->is_auto_increment ?
 291         ' GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1)' : '';
 292     $field_def .= $data_type =~ /(CHAR|CLOB|NUMERIC|DECIMAL)/i ? "(${size})" : '';
 293     $field_def .= !$field->is_nullable ? ' NOT NULL':'';
 294 #            $field_def .= $field->is_primary_key ? ' PRIMARY KEY':'';
 295     $field_def .= !defined $field->default_value ? '' :
 296         $field->default_value =~ /current( |_)timestamp/i ||
 297         $field->default_value =~ /\Qnow()\E/i ?
 298         ' DEFAULT CURRENT TIMESTAMP' : defined $field->default_value ?
 299         (" DEFAULT " . ($data_type =~ /(INT|DOUBLE)/i ?
 300                         $field->default_value : "'" . $field->default_value . "'")
 301          ) : '';
 302
 303     return $field_def;
 304 }
 305
 306 sub create_index
 307 {
 308     my ($index) = @_;
 309
 310     my $out = sprintf('CREATE %sINDEX %s ON %s ( %s );',
 311                       $index->type() =~ /^UNIQUE$/i ? 'UNIQUE' : '',
 312                       $index->name,
 313                       $index->table->name,
 314                       join(', ', $index->fields) );
 315
 316     return $out;
 317 }
 318
 319 sub create_constraint
 320 {
 321     my ($constraint) = @_;
 322
 323     my (@con_defs, @fks);
 324
 325     my $ctype =  $constraint->type =~ /^PRIMARY(_|\s)KEY$/i ? 'PRIMARY KEY' :
 326                  $constraint->type =~ /^UNIQUE$/i      ? 'UNIQUE' :
 327                  $constraint->type =~ /^CHECK_C$/i     ? 'CHECK' :
 328                  $constraint->type =~ /^FOREIGN(_|\s)KEY$/i ? 'FOREIGN KEY' : '';
 329
 330     my $expr = $constraint->type =~ /^CHECK_C$/i ? $constraint->expression :
 331         '';
 332     my $ref = $constraint->type =~ /^FOREIGN(_|\s)KEY$/i ? ('REFERENCES ' . $constraint->reference_table . '(' . join(', ', $constraint->reference_fields) . ')') : '';
 333     my $update = $constraint->on_update ? $constraint->on_update : '';
 334     my $delete = $constraint->on_delete ? $constraint->on_delete : '';
 335
 336     my $out = join(' ', grep { $_ }
 337                       $constraint->name ? ('CONSTRAINT ' . $constraint->name) : '',
 338                       $ctype,
 339                       '(' . join (', ', $constraint->fields) . ')',
 340                       $expr ? $expr : $ref,
 341                       $update,
 342                       $delete);
 343     if ($constraint->type eq FOREIGN_KEY) {
 344         my $table_name = $constraint->table->name;
 345         $out = "ALTER TABLE $table_name ADD $out;";
 346         push @fks, $out;
 347     }
 348     else {
 349         push @con_defs, $out;
 350     }
 351
 352     return \@con_defs, \@fks;
 353
 354 }
 355
 356 sub create_view
 357 {
 358     my ($view) = @_;
 359
 360     my $out = sprintf("CREATE VIEW %s AS\n%s;",
 361                       $view->name,
 362                       $view->sql);
 363
 364     return $out;
 365 }
 366
 367 sub create_trigger
 368 {
 369     my ($trigger) = @_;
 370 # create: CREATE TRIGGER trigger_name before type /ON/i table_name reference_b(?) /FOR EACH ROW/i 'MODE DB2SQL' triggered_action
 371
 372     my $db_events = join ', ', $trigger->database_events;
 373     my $out = sprintf('CREATE TRIGGER %s %s %s ON %s %s %s MODE DB2SQL %s',
 374                       $trigger->name,
 375                       $trigger->perform_action_when || 'AFTER',
 376                       $db_events =~ /update_on/i ?
 377                         ('UPDATE OF '. join(', ', $trigger->fields)) :
 378                         $db_events || 'UPDATE',
 379                       $trigger->table->name,
 380                       $trigger->extra->{reference} || 'REFERENCING OLD AS oldrow NEW AS newrow',
 381                       $trigger->extra->{granularity} || 'FOR EACH ROW',
 382                       $trigger->action );
 383
 384     return $out;
 385
 386 }
 387
 388 sub alter_field
 389 {
 390     my ($from_field, $to_field) = @_;
 391
 392     my $data_type = uc($dt_translate{lc($to_field->data_type)} || $to_field->data_type);
 393
 394     my $size = $to_field->size();
 395     $data_type .= $data_type =~ /CHAR/i ? "(${size})" : '';
 396
 397     # DB2 will only allow changing of varchar/vargraphic datatypes
 398     # to extend their lengths. Or changing of text types to other
 399     # texttypes, and numeric types to larger numeric types. (v8)
 400     # We can also drop/add keys, checks and constraints, but not
 401     # columns !?
 402
 403     my $out = sprintf('ALTER TABLE %s ALTER %s SET DATATYPE %s',
 404                       $to_field->table->name,
 405                       $to_field->name,
 406                       $data_type);
 407
 408 }
 409
 410 sub add_field
 411 {
 412     my ($new_field) = @_;
 413
 414     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 415                       $new_field->table->name,
 416                       create_field($new_field));
 417
 418     return $out;
 419 }
 420
 421 sub drop_field
 422 {
 423     my ($field) = @_;
 424
 425     return '';
 426 }
 427 1;