lib/SQL/Translator/Producer/DB2.pm

   1 package SQL::Translator::Producer::DB2;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: DB2.pm,v 1.4 2006-08-26 11:30:31 schiffbruechige Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2002-4 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 = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/;
  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, @index_defs);
 209     foreach my $table ($schema->get_tables)
 210     {
 211         push @table_defs, 'DROP TABLE ' . $table->name . ";" if $add_drop_table;
 212         push @table_defs, create_table($table, {
 213             no_comments => $no_comments});
 214
 215         foreach my $index ($table->get_indices)
 216         {
 217             push @index_defs, create_index($index);
 218         }
 219
 220     }
 221     my (@view_defs);
 222     foreach my $view ( $schema->get_views )
 223     {
 224         push @view_defs, create_view($view);
 225     }
 226     my (@trigger_defs);
 227     foreach my $trigger ( $schema->get_triggers )
 228     {
 229         push @trigger_defs, create_trigger($trigger);
 230     }
 231
 232     return wantarray ? (@table_defs, @index_defs, @view_defs, @trigger_defs) :
 233         $output . join("\n\n", @table_defs, @index_defs, @view_defs, @trigger_defs) . "\n";
 234 }
 235
 236 { my %objnames;
 237
 238     sub check_name
 239     {
 240         my ($name, $type, $length) = @_;
 241
 242         my $newname = $name;
 243         if(length($name) > $length)   ## Maximum table name length is 18
 244         {
 245             warn "Table name $name is longer than $length characters, truncated" if $WARN;
 246 #             if(grep {$_ eq substr($name, 0, $length) }
 247 #                               values(%{$objnames{$type}}))
 248 #             {
 249 #                 die "Got multiple matching table names when truncated";
 250 #             }
 251 #             $objnames{$type}{$name} = substr($name, 0,$length);
 252 #             $newname = $objnames{$type}{$name};
 253         }
 254
 255         if($db2_reserved{uc($newname)})
 256         {
 257             warn "$newname is a reserved word in DB2!" if $WARN;
 258         }
 259
 260 #        return sprintf("%-*s", $length-5, $newname);
 261         return $newname;
 262     }
 263 }
 264
 265 sub create_table
 266 {
 267     my ($table, $options) = @_;
 268
 269     my $table_name = check_name($table->name, 'tables', 128);
 270     # this limit is 18 in older DB2s ! (<= 8)
 271
 272     my (@field_defs, @comments);
 273     push @comments, "--\n-- Table: $table_name\n--" unless $options->{no_comments};
 274     foreach my $field ($table->get_fields)
 275     {
 276         push @field_defs, create_field($field);
 277     }
 278     my @con_defs;
 279     foreach my $con ($table->get_constraints)
 280     {
 281         push @con_defs, create_constraint($con);
 282     }
 283     my $pkey = join(", ", $table->primary_key()->fields);
 284
 285     my $tablespace = $table->extra()->{'TABLESPACE'} || '';
 286     my $table_def = "CREATE TABLE $table_name (\n";
 287     $table_def .= join (",\n", @field_defs);
 288     $table_def .= join (",\n", @con_defs);
 289     $table_def .= ",\n PRIMARY KEY($pkey)";
 290     $table_def .= "\n)";
 291     $table_def .= $tablespace ? "IN $tablespace;" : ';';
 292
 293     return $table_def;
 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/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 '" .  $field->default_value . "'") : '';
 318
 319     return $field_def;
 320 }
 321
 322 sub create_index
 323 {
 324     my ($index) = @_;
 325
 326     my $out = sprintf('CREATE %sINDEX %s ON %s ( %s );',
 327                       $index->type() =~ /^UNIQUE$/i ? 'UNIQUE' : '',
 328                       $index->name,
 329                       $index->table->name,
 330                       join(', ', $index->fields) );
 331
 332     return $out;
 333 }
 334
 335 sub create_constraint
 336 {
 337     my ($constraint) = @_;
 338
 339     return '' if($constraint->type =~ /^PRIMARY(_|\s)KEY$/i);
 340
 341     my $ctype =  $constraint->type =~ /^PRIMARY(_|\s)KEY$/i ? 'PRIMARY KEY' :
 342                  $constraint->type =~ /^UNIQUE$/i      ? 'UNIQUE' :
 343                  $constraint->type =~ /^CHECK_C$/i     ? 'CHECK' :
 344                  $constraint->type =~ /^FOREIGN_KEY$/i ? 'FOREIGN KEY' : '';
 345
 346     my $expr = $constraint->type =~ /^CHECK_C$/i ? $constraint->expression :
 347         '';
 348     my $ref = $constraint->type =~ /^FOREIGN_KEY$/i ? ('REFERENCES ' . $constraint->reference_table . '(' . join(', ', $constraint->reference_fields) . ')') : '';
 349     my $update = $constraint->on_update ? $constraint->on_update : '';
 350     my $delete = $constraint->on_delete ? $constraint->on_delete : '';
 351
 352     my $out = sprintf('%s %s %s %s %s %s',
 353                       $constraint->name ? ('CONSTRAINT ' . $constraint->name) : '',
 354                       $ctype,
 355                       '(' . join (', ', $constraint->fields) . ')',
 356                       $expr ? $expr : $ref,
 357                       $update,
 358                       $delete);
 359
 360
 361     return $out;
 362
 363 }
 364
 365 sub create_view
 366 {
 367     my ($view) = @_;
 368
 369     my $out = sprintf("CREATE VIEW %s AS\n%s;",
 370                       $view->name,
 371                       $view->sql);
 372
 373     return $out;
 374 }
 375
 376 sub create_trigger
 377 {
 378     my ($trigger) = @_;
 379 # create: CREATE TRIGGER trigger_name before type /ON/i table_name reference_b(?) /FOR EACH ROW/i 'MODE DB2SQL' triggered_action
 380
 381     my $out = sprintf('CREATE TRIGGER %s %s %s ON %s %s %s MODE DB2SQL %s',
 382                       $trigger->name,
 383                       $trigger->perform_action_when || 'AFTER',
 384                       $trigger->database_event =~ /update_on/i ?
 385                         ('UPDATE OF '. join(', ', $trigger->fields)) :
 386                         $trigger->database_event || 'UPDATE',
 387                       $trigger->table->name,
 388                       $trigger->extra->{reference} || 'REFERENCING OLD AS oldrow NEW AS newrow',
 389                       $trigger->extra->{granularity} || 'FOR EACH ROW',
 390                       $trigger->action );
 391
 392     return $out;
 393
 394 }
 395
 396 sub alter_field
 397 {
 398     my ($from_field, $to_field) = @_;
 399
 400     my $data_type = uc($dt_translate{lc($to_field->data_type)} || $to_field->data_type);
 401
 402     my $size = $to_field->size();
 403     $data_type .= $data_type =~ /CHAR/i ? "(${size})" : '';
 404
 405     # DB2 will only allow changing of varchar/vargraphic datatypes
 406     # to extend their lengths. Or changing of text types to other
 407     # texttypes, and numeric types to larger numeric types. (v8)
 408     # We can also drop/add keys, checks and constraints, but not
 409     # columns !?
 410
 411     my $out = sprintf('ALTER TABLE %s ALTER %s SET DATATYPE %s',
 412                       $to_field->table->name,
 413                       $to_field->name,
 414                       $data_type);
 415
 416 }
 417
 418 sub add_field
 419 {
 420     my ($new_field) = @_;
 421
 422     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 423                       $new_field->table->name,
 424                       create_field($new_field));
 425
 426     return $out;
 427 }
 428
 429 sub drop_field
 430 {
 431     my ($field) = @_;
 432
 433     return '';
 434 }
 435 1;