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