lib/SQL/Translator/Producer/DB2.pm

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