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 sub produce
 176 {
 177     my ($translator) = @_;
 178     $DEBUG             = $translator->debug;
 179     $WARN              = $translator->show_warnings;
 180     my $no_comments    = $translator->no_comments;
 181     my $add_drop_table = $translator->add_drop_table;
 182     my $schema         = $translator->schema;
 183     my $output         = '';
 184     my $indent         = '    ';
 185
 186     $output .= header_comment unless($no_comments);
 187     my (@table_defs, @fks, @index_defs);
 188     foreach my $table ($schema->get_tables)
 189     {
 190         push @table_defs, 'DROP TABLE ' . $table->name . ";" if $add_drop_table;
 191         my ($table_def, $fks) = create_table($table, {
 192             no_comments => $no_comments});
 193         push @table_defs, $table_def;
 194         push @fks, @$fks;
 195
 196         foreach my $index ($table->get_indices)
 197         {
 198             push @index_defs, create_index($index);
 199         }
 200
 201     }
 202     my (@view_defs);
 203     foreach my $view ( $schema->get_views )
 204     {
 205         push @view_defs, create_view($view);
 206     }
 207     my (@trigger_defs);
 208     foreach my $trigger ( $schema->get_triggers )
 209     {
 210         push @trigger_defs, create_trigger($trigger);
 211     }
 212
 213     return wantarray ? (@table_defs, @fks, @index_defs, @view_defs, @trigger_defs) :
 214         $output . join("\n\n", @table_defs, @fks, @index_defs, @view_defs, @trigger_defs) . "\n";
 215 }
 216
 217 { my %objnames;
 218
 219     sub check_name
 220     {
 221         my ($name, $type, $length) = @_;
 222
 223         my $newname = $name;
 224         if(length($name) > $length)   ## Maximum table name length is 18
 225         {
 226             warn "Table name $name is longer than $length characters, truncated" if $WARN;
 227 #             if(grep {$_ eq substr($name, 0, $length) }
 228 #                               values(%{$objnames{$type}}))
 229 #             {
 230 #                 die "Got multiple matching table names when truncated";
 231 #             }
 232 #             $objnames{$type}{$name} = substr($name, 0,$length);
 233 #             $newname = $objnames{$type}{$name};
 234         }
 235
 236         if($db2_reserved{uc($newname)})
 237         {
 238             warn "$newname is a reserved word in DB2!" if $WARN;
 239         }
 240
 241 #        return sprintf("%-*s", $length-5, $newname);
 242         return $newname;
 243     }
 244 }
 245
 246 sub create_table
 247 {
 248     my ($table, $options) = @_;
 249
 250     my $table_name = check_name($table->name, 'tables', 128);
 251     # this limit is 18 in older DB2s ! (<= 8)
 252
 253     my (@field_defs, @comments);
 254     push @comments, "--\n-- Table: $table_name\n--" unless $options->{no_comments};
 255     foreach my $field ($table->get_fields)
 256     {
 257         push @field_defs, create_field($field);
 258     }
 259     my (@con_defs, @fks);
 260     foreach my $con ($table->get_constraints)
 261     {
 262         my ($cdefs, $fks) = create_constraint($con);
 263         push @con_defs, @$cdefs;
 264         push @fks, @$fks;
 265     }
 266
 267     my $tablespace = $table->extra()->{'TABLESPACE'} || '';
 268     my $table_def = "CREATE TABLE $table_name (\n";
 269     $table_def .= join (",\n", map { "  $_" } @field_defs, @con_defs);
 270     $table_def .= "\n)";
 271     $table_def .= $tablespace ? "IN $tablespace;" : ';';
 272
 273     return $table_def, \@fks;
 274 }
 275
 276 sub create_field
 277 {
 278     my ($field) = @_;
 279
 280     my $field_name = check_name($field->name, 'fields', 30);
 281 #    use Data::Dumper;
 282 #    print Dumper(\%dt_translate);
 283 #    print $field->data_type, " ", $dt_translate{lc($field->data_type)}, "\n";
 284     my $data_type = uc($dt_translate{lc($field->data_type)} || $field->data_type);
 285     my $size = $field->size();
 286
 287     my $field_def = "$field_name $data_type";
 288     $field_def .= $field->is_auto_increment ?
 289         ' GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1)' : '';
 290     $field_def .= $data_type =~ /(CHAR|CLOB|NUMERIC|DECIMAL)/i ? "(${size})" : '';
 291     $field_def .= !$field->is_nullable ? ' NOT NULL':'';
 292 #            $field_def .= $field->is_primary_key ? ' PRIMARY KEY':'';
 293     $field_def .= !defined $field->default_value ? '' :
 294         $field->default_value =~ /current( |_)timestamp/i ||
 295         $field->default_value =~ /\Qnow()\E/i ?
 296         ' DEFAULT CURRENT TIMESTAMP' : defined $field->default_value ?
 297         (" DEFAULT " . ($data_type =~ /(INT|DOUBLE)/i ?
 298                         $field->default_value : "'" . $field->default_value . "'")
 299          ) : '';
 300
 301     return $field_def;
 302 }
 303
 304 sub create_index
 305 {
 306     my ($index) = @_;
 307
 308     my $out = sprintf('CREATE %sINDEX %s ON %s ( %s );',
 309                       $index->type() =~ /^UNIQUE$/i ? 'UNIQUE' : '',
 310                       $index->name,
 311                       $index->table->name,
 312                       join(', ', $index->fields) );
 313
 314     return $out;
 315 }
 316
 317 sub create_constraint
 318 {
 319     my ($constraint) = @_;
 320
 321     my (@con_defs, @fks);
 322
 323     my $ctype =  $constraint->type =~ /^PRIMARY(_|\s)KEY$/i ? 'PRIMARY KEY' :
 324                  $constraint->type =~ /^UNIQUE$/i      ? 'UNIQUE' :
 325                  $constraint->type =~ /^CHECK_C$/i     ? 'CHECK' :
 326                  $constraint->type =~ /^FOREIGN(_|\s)KEY$/i ? 'FOREIGN KEY' : '';
 327
 328     my $expr = $constraint->type =~ /^CHECK_C$/i ? $constraint->expression :
 329         '';
 330     my $ref = $constraint->type =~ /^FOREIGN(_|\s)KEY$/i ? ('REFERENCES ' . $constraint->reference_table . '(' . join(', ', $constraint->reference_fields) . ')') : '';
 331     my $update = $constraint->on_update ? $constraint->on_update : '';
 332     my $delete = $constraint->on_delete ? $constraint->on_delete : '';
 333
 334     my $out = join(' ', grep { $_ }
 335                       $constraint->name ? ('CONSTRAINT ' . $constraint->name) : '',
 336                       $ctype,
 337                       '(' . join (', ', $constraint->fields) . ')',
 338                       $expr ? $expr : $ref,
 339                       $update,
 340                       $delete);
 341     if ($constraint->type eq FOREIGN_KEY) {
 342         my $table_name = $constraint->table->name;
 343         $out = "ALTER TABLE $table_name ADD $out;";
 344         push @fks, $out;
 345     }
 346     else {
 347         push @con_defs, $out;
 348     }
 349
 350     return \@con_defs, \@fks;
 351
 352 }
 353
 354 sub create_view
 355 {
 356     my ($view) = @_;
 357
 358     my $out = sprintf("CREATE VIEW %s AS\n%s;",
 359                       $view->name,
 360                       $view->sql);
 361
 362     return $out;
 363 }
 364
 365 sub create_trigger
 366 {
 367     my ($trigger) = @_;
 368 # create: CREATE TRIGGER trigger_name before type /ON/i table_name reference_b(?) /FOR EACH ROW/i 'MODE DB2SQL' triggered_action
 369
 370     my $db_events = join ', ', $trigger->database_events;
 371     my $out = sprintf('CREATE TRIGGER %s %s %s ON %s %s %s MODE DB2SQL %s',
 372                       $trigger->name,
 373                       $trigger->perform_action_when || 'AFTER',
 374                       $db_events =~ /update_on/i ?
 375                         ('UPDATE OF '. join(', ', $trigger->fields)) :
 376                         $db_events || 'UPDATE',
 377                       $trigger->table->name,
 378                       $trigger->extra->{reference} || 'REFERENCING OLD AS oldrow NEW AS newrow',
 379                       $trigger->extra->{granularity} || 'FOR EACH ROW',
 380                       $trigger->action );
 381
 382     return $out;
 383
 384 }
 385
 386 sub alter_field
 387 {
 388     my ($from_field, $to_field) = @_;
 389
 390     my $data_type = uc($dt_translate{lc($to_field->data_type)} || $to_field->data_type);
 391
 392     my $size = $to_field->size();
 393     $data_type .= $data_type =~ /CHAR/i ? "(${size})" : '';
 394
 395     # DB2 will only allow changing of varchar/vargraphic datatypes
 396     # to extend their lengths. Or changing of text types to other
 397     # texttypes, and numeric types to larger numeric types. (v8)
 398     # We can also drop/add keys, checks and constraints, but not
 399     # columns !?
 400
 401     my $out = sprintf('ALTER TABLE %s ALTER %s SET DATATYPE %s',
 402                       $to_field->table->name,
 403                       $to_field->name,
 404                       $data_type);
 405
 406 }
 407
 408 sub add_field
 409 {
 410     my ($new_field) = @_;
 411
 412     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 413                       $new_field->table->name,
 414                       create_field($new_field));
 415
 416     return $out;
 417 }
 418
 419 sub drop_field
 420 {
 421     my ($field) = @_;
 422
 423     return '';
 424 }
 425 1;