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 warnings;
  23 our ( $DEBUG, $WARN );
  24 our $VERSION = '1.59';
  25 $DEBUG   = 0 unless defined $DEBUG;
  26
  27 use SQL::Translator::Schema::Constants;
  28 use SQL::Translator::Utils qw(header_comment);
  29
  30
  31 # http://publib.boulder.ibm.com/infocenter/db2help/topic/com.ibm.db2.udb.doc/ad/r0006844.htm
  32
  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)
  36
  37 my %dt_translate;
  38 BEGIN {
  39   %dt_translate = (
  40     #
  41     # MySQL types
  42     #
  43     int        => 'integer',
  44     mediumint  => 'integer',
  45     tinyint    => 'smallint',
  46     char       => 'char',
  47     tinyblob   => 'blob',
  48     mediumblob => 'blob',
  49     longblob   => 'long varchar for bit data',
  50     tinytext   => 'varchar',
  51     text       => 'varchar',
  52     longtext   => 'varchar',
  53     mediumtext => 'varchar',
  54     enum       => 'varchar',
  55     set        => 'varchar',
  56     date       => 'date',
  57     datetime   => 'timestamp',
  58     time       => 'time',
  59     year       => 'date',
  60
  61     #
  62     # PostgreSQL types
  63     #
  64     'double precision'  => 'double',
  65     serial              => 'integer',
  66     bigserial           => 'integer',
  67     money               => 'double',
  68     character           => 'char',
  69     'character varying' => 'varchar',
  70     bytea               => 'BLOB',
  71     interval            => 'integer',
  72     boolean             => 'smallint',
  73     point               => 'integer',
  74     line                => 'integer',
  75     lseg                => 'integer',
  76     box                 => 'integer',
  77     path                => 'integer',
  78     polygon             => 'integer',
  79     circle              => 'integer',
  80     cidr                => 'integer',
  81     inet                => 'varchar',
  82     macaddr             => 'varchar',
  83     bit                 => 'number',
  84     'bit varying'       => 'number',
  85
  86     #
  87     # DB types
  88     #
  89     number              => 'integer',
  90     varchar2            => 'varchar',
  91     long                => 'clob',
  92 );
  93 }
  94
  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
 106 AS                 EACH           LOCKSIZE      ROW
 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
 130 CHECK              FREE           NULL          STAY
 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
 149 CURRENT            IF             PART          UNDO
 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
 162 DAY                INTO           PSID          VIEW
 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
 174 /;
 175
 176 sub produce
 177 {
 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;
 184     my $output         = '';
 185     my $indent         = '    ';
 186
 187     $output .= header_comment unless($no_comments);
 188     my (@table_defs, @fks, @index_defs);
 189     foreach my $table ($schema->get_tables)
 190     {
 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;
 195         push @fks, @$fks;
 196
 197         foreach my $index ($table->get_indices)
 198         {
 199             push @index_defs, create_index($index);
 200         }
 201
 202     }
 203     my (@view_defs);
 204     foreach my $view ( $schema->get_views )
 205     {
 206         push @view_defs, create_view($view);
 207     }
 208     my (@trigger_defs);
 209     foreach my $trigger ( $schema->get_triggers )
 210     {
 211         push @trigger_defs, create_trigger($trigger);
 212     }
 213
 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";
 216 }
 217
 218 { my %objnames;
 219
 220     sub check_name
 221     {
 222         my ($name, $type, $length) = @_;
 223
 224         my $newname = $name;
 225         if(length($name) > $length)   ## Maximum table name length is 18
 226         {
 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}}))
 230 #             {
 231 #                 die "Got multiple matching table names when truncated";
 232 #             }
 233 #             $objnames{$type}{$name} = substr($name, 0,$length);
 234 #             $newname = $objnames{$type}{$name};
 235         }
 236
 237         if($db2_reserved{uc($newname)})
 238         {
 239             warn "$newname is a reserved word in DB2!" if $WARN;
 240         }
 241
 242 #        return sprintf("%-*s", $length-5, $newname);
 243         return $newname;
 244     }
 245 }
 246
 247 sub create_table
 248 {
 249     my ($table, $options) = @_;
 250
 251     my $table_name = check_name($table->name, 'tables', 128);
 252     # this limit is 18 in older DB2s ! (<= 8)
 253
 254     my (@field_defs, @comments);
 255     push @comments, "--\n-- Table: $table_name\n--" unless $options->{no_comments};
 256     foreach my $field ($table->get_fields)
 257     {
 258         push @field_defs, create_field($field);
 259     }
 260     my (@con_defs, @fks);
 261     foreach my $con ($table->get_constraints)
 262     {
 263         my ($cdefs, $fks) = create_constraint($con);
 264         push @con_defs, @$cdefs;
 265         push @fks, @$fks;
 266     }
 267
 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);
 271     $table_def .= "\n)";
 272     $table_def .= $tablespace ? "IN $tablespace;" : ';';
 273
 274     return $table_def, \@fks;
 275 }
 276
 277 sub create_field
 278 {
 279     my ($field) = @_;
 280
 281     my $field_name = check_name($field->name, 'fields', 30);
 282 #    use Data::Dumper;
 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();
 287
 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 . "'")
 300          ) : '';
 301
 302     return $field_def;
 303 }
 304
 305 sub create_index
 306 {
 307     my ($index) = @_;
 308
 309     my $out = sprintf('CREATE %sINDEX %s ON %s ( %s );',
 310                       $index->type() =~ /^UNIQUE$/i ? 'UNIQUE' : '',
 311                       $index->name,
 312                       $index->table->name,
 313                       join(', ', $index->fields) );
 314
 315     return $out;
 316 }
 317
 318 sub create_constraint
 319 {
 320     my ($constraint) = @_;
 321
 322     my (@con_defs, @fks);
 323
 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' : '';
 328
 329     my $expr = $constraint->type =~ /^CHECK_C$/i ? $constraint->expression :
 330         '';
 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 : '';
 334
 335     my $out = join(' ', grep { $_ }
 336                       $constraint->name ? ('CONSTRAINT ' . $constraint->name) : '',
 337                       $ctype,
 338                       '(' . join (', ', $constraint->fields) . ')',
 339                       $expr ? $expr : $ref,
 340                       $update,
 341                       $delete);
 342     if ($constraint->type eq FOREIGN_KEY) {
 343         my $table_name = $constraint->table->name;
 344         $out = "ALTER TABLE $table_name ADD $out;";
 345         push @fks, $out;
 346     }
 347     else {
 348         push @con_defs, $out;
 349     }
 350
 351     return \@con_defs, \@fks;
 352
 353 }
 354
 355 sub create_view
 356 {
 357     my ($view) = @_;
 358
 359     my $out = sprintf("CREATE VIEW %s AS\n%s;",
 360                       $view->name,
 361                       $view->sql);
 362
 363     return $out;
 364 }
 365
 366 sub create_trigger
 367 {
 368     my ($trigger) = @_;
 369 # create: CREATE TRIGGER trigger_name before type /ON/i table_name reference_b(?) /FOR EACH ROW/i 'MODE DB2SQL' triggered_action
 370
 371     my $db_events = join ', ', $trigger->database_events;
 372     my $out = sprintf('CREATE TRIGGER %s %s %s ON %s %s %s MODE DB2SQL %s',
 373                       $trigger->name,
 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',
 381                       $trigger->action );
 382
 383     return $out;
 384
 385 }
 386
 387 sub alter_field
 388 {
 389     my ($from_field, $to_field) = @_;
 390
 391     my $data_type = uc($dt_translate{lc($to_field->data_type)} || $to_field->data_type);
 392
 393     my $size = $to_field->size();
 394     $data_type .= $data_type =~ /CHAR/i ? "(${size})" : '';
 395
 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
 400     # columns !?
 401
 402     my $out = sprintf('ALTER TABLE %s ALTER %s SET DATATYPE %s',
 403                       $to_field->table->name,
 404                       $to_field->name,
 405                       $data_type);
 406
 407 }
 408
 409 sub add_field
 410 {
 411     my ($new_field) = @_;
 412
 413     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 414                       $new_field->table->name,
 415                       create_field($new_field));
 416
 417     return $out;
 418 }
 419
 420 sub drop_field
 421 {
 422     my ($field) = @_;
 423
 424     return '';
 425 }
 426 1;