lib/SQL/Translator/Producer/DB2.pm

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