lib/SQL/Translator/Producer/DB2.pm

   1 package SQL::Translator::Producer::DB2;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: DB2.pm,v 1.2 2006-05-24 22:06:56 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.2 $ =~ /(\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     #
  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 my %db2_reserved = map { $_ => 1} qw/
 111 ADD                DETERMINISTIC  LEAVE         RESTART
 112 AFTER              DISALLOW       LEFT          RESTRICT
 113 ALIAS              DISCONNECT     LIKE          RESULT
 114 ALL                DISTINCT       LINKTYPE      RESULT_SET_LOCATOR
 115 ALLOCATE           DO             LOCAL         RETURN
 116 ALLOW              DOUBLE         LOCALE        RETURNS
 117 ALTER              DROP           LOCATOR       REVOKE
 118 AND                DSNHATTR       LOCATORS      RIGHT
 119 ANY                DSSIZE         LOCK          ROLLBACK
 120 APPLICATION        DYNAMIC        LOCKMAX       ROUTINE
 121 AS                 EACH           LOCKSIZE      ROW
 122 ASSOCIATE          EDITPROC       LONG          ROWS
 123 ASUTIME            ELSE           LOOP          RRN
 124 AUDIT              ELSEIF         MAXVALUE      RUN
 125 AUTHORIZATION      ENCODING       MICROSECOND   SAVEPOINT
 126 AUX                END            MICROSECONDS  SCHEMA
 127 AUXILIARY          END-EXEC       MINUTE        SCRATCHPAD
 128 BEFORE             END-EXEC1      MINUTES       SECOND
 129 BEGIN              ERASE          MINVALUE      SECONDS
 130 BETWEEN            ESCAPE         MODE          SECQTY
 131 BINARY             EXCEPT         MODIFIES      SECURITY
 132 BUFFERPOOL         EXCEPTION      MONTH         SELECT
 133 BY                 EXCLUDING      MONTHS        SENSITIVE
 134 CACHE              EXECUTE        NEW           SET
 135 CALL               EXISTS         NEW_TABLE     SIGNAL
 136 CALLED             EXIT           NO            SIMPLE
 137 CAPTURE            EXTERNAL       NOCACHE       SOME
 138 CARDINALITY        FENCED         NOCYCLE       SOURCE
 139 CASCADED           FETCH          NODENAME      SPECIFIC
 140 CASE               FIELDPROC      NODENUMBER    SQL
 141 CAST               FILE           NOMAXVALUE    SQLID
 142 CCSID              FINAL          NOMINVALUE    STANDARD
 143 CHAR               FOR            NOORDER       START
 144 CHARACTER          FOREIGN        NOT           STATIC
 145 CHECK              FREE           NULL          STAY
 146 CLOSE              FROM           NULLS         STOGROUP
 147 CLUSTER            FULL           NUMPARTS      STORES
 148 COLLECTION         FUNCTION       OBID          STYLE
 149 COLLID             GENERAL        OF            SUBPAGES
 150 COLUMN             GENERATED      OLD           SUBSTRING
 151 COMMENT            GET            OLD_TABLE     SYNONYM
 152 COMMIT             GLOBAL         ON            SYSFUN
 153 CONCAT             GO             OPEN          SYSIBM
 154 CONDITION          GOTO           OPTIMIZATION  SYSPROC
 155 CONNECT            GRANT          OPTIMIZE      SYSTEM
 156 CONNECTION         GRAPHIC        OPTION        TABLE
 157 CONSTRAINT         GROUP          OR            TABLESPACE
 158 CONTAINS           HANDLER        ORDER         THEN
 159 CONTINUE           HAVING         OUT           TO
 160 COUNT              HOLD           OUTER         TRANSACTION
 161 COUNT_BIG          HOUR           OVERRIDING    TRIGGER
 162 CREATE             HOURS          PACKAGE       TRIM
 163 CROSS              IDENTITY       PARAMETER     TYPE
 164 CURRENT            IF             PART          UNDO
 165 CURRENT_DATE       IMMEDIATE      PARTITION     UNION
 166 CURRENT_LC_CTYPE   IN             PATH          UNIQUE
 167 CURRENT_PATH       INCLUDING      PIECESIZE     UNTIL
 168 CURRENT_SERVER     INCREMENT      PLAN          UPDATE
 169 CURRENT_TIME       INDEX          POSITION      USAGE
 170 CURRENT_TIMESTAMP  INDICATOR      PRECISION     USER
 171 CURRENT_TIMEZONE   INHERIT        PREPARE       USING
 172 CURRENT_USER       INNER          PRIMARY       VALIDPROC
 173 CURSOR             INOUT          PRIQTY        VALUES
 174 CYCLE              INSENSITIVE    PRIVILEGES    VARIABLE
 175 DATA               INSERT         PROCEDURE     VARIANT
 176 DATABASE           INTEGRITY      PROGRAM       VCAT
 177 DAY                INTO           PSID          VIEW
 178 DAYS               IS             QUERYNO       VOLUMES
 179 DB2GENERAL         ISOBID         READ          WHEN
 180 DB2GENRL           ISOLATION      READS         WHERE
 181 DB2SQL             ITERATE        RECOVERY      WHILE
 182 DBINFO             JAR            REFERENCES    WITH
 183 DECLARE            JAVA           REFERENCING   WLM
 184 DEFAULT            JOIN           RELEASE       WRITE
 185 DEFAULTS           KEY            RENAME        YEAR
 186 DEFINITION         LABEL          REPEAT        YEARS
 187 DELETE             LANGUAGE       RESET
 188 DESCRIPTOR         LC_CTYPE       RESIGNAL
 189 /;
 190
 191 #------------------------------------------------------------------------------
 192
 193 sub produce
 194 {
 195     my ($translator) = @_;
 196     $DEBUG             = $translator->debug;
 197     $WARN              = $translator->show_warnings;
 198     my $no_comments    = $translator->no_comments;
 199     my $add_drop_table = $translator->add_drop_table;
 200     my $schema         = $translator->schema;
 201     my $output         = '';
 202     my $indent         = '    ';
 203
 204     $output .= header_comment unless($no_comments);
 205     my (@table_defs, @index_defs);
 206     foreach my $table ($schema->get_tables)
 207     {
 208         push @table_defs, 'DROP TABLE ' . $table->name . ";\n" if $add_drop_table;
 209         push @table_defs, create_table($table, {
 210             no_comments => $no_comments});
 211
 212         foreach my $index ($table->get_indices)
 213         {
 214             push @index_defs, create_index($index);
 215         }
 216
 217     }
 218     my (@view_defs);
 219     foreach my $view ( $schema->get_views )
 220     {
 221         push @view_defs, create_view($view);
 222     }
 223     my (@trigger_defs);
 224     foreach my $trigger ( $schema->get_triggers )
 225     {
 226         push @trigger_defs, create_trigger($trigger);
 227     }
 228
 229     $output .= join("\n\n", @table_defs, @index_defs, @view_defs, @trigger_defs) . "\n";
 230 }
 231
 232 { my %objnames;
 233
 234     sub check_name
 235     {
 236         my ($name, $type, $length) = @_;
 237
 238         my $newname = $name;
 239         if(length($name) > $length)   ## Maximum table name length is 18
 240         {
 241             warn "Table name $name is longer than $length characters, truncated" if $WARN;
 242 #             if(grep {$_ eq substr($name, 0, $length) }
 243 #                               values(%{$objnames{$type}}))
 244 #             {
 245 #                 die "Got multiple matching table names when truncated";
 246 #             }
 247 #             $objnames{$type}{$name} = substr($name, 0,$length);
 248 #             $newname = $objnames{$type}{$name};
 249         }
 250
 251         if($db2_reserved{uc($newname)})
 252         {
 253             warn "$newname is a reserved word in DB2!" if $WARN;
 254         }
 255
 256         return sprintf("%-*s", $length-5, $newname);
 257     }
 258 }
 259
 260 sub create_table
 261 {
 262     my ($table, $options) = @_;
 263
 264     my $table_name = check_name($table->name, 'tables', 128);
 265     # this limit is 18 in older DB2s ! (<= 8)
 266
 267     my (@field_defs, @comments);
 268     push @comments, "--\n-- Table: $table_name\n--" unless $options->{no_comments};
 269     foreach my $field ($table->get_fields)
 270     {
 271         push @field_defs, create_field($field);
 272     }
 273     my @con_defs;
 274     foreach my $con ($table->get_constraints)
 275     {
 276         push @con_defs, create_constraint($con);
 277     }
 278     my $pkey = join(", ", $table->primary_key()->fields);
 279
 280     my $tablespace = $table->extra()->{'TABLESPACE'} || '';
 281     my $table_def = "CREATE TABLE $table_name (\n";
 282     $table_def .= join (",\n", @field_defs);
 283     $table_def .= join (",\n", @con_defs);
 284     $table_def .= ",\n PRIMARY KEY($pkey)";
 285     $table_def .= "\n)";
 286     $table_def .= $tablespace ? "IN $tablespace;" : ';';
 287
 288     return $table_def;
 289 }
 290
 291 sub create_field
 292 {
 293     my ($field) = @_;
 294
 295     my $field_name = check_name($field->name, 'fields', 30);
 296 #    use Data::Dumper;
 297 #    print Dumper(\%dt_translate);
 298 #    print $field->data_type, " ", $dt_translate{lc($field->data_type)}, "\n";
 299     my $data_type = uc($dt_translate{lc($field->data_type)} || $field->data_type);
 300     my $size = $field->size();
 301
 302     my $field_def = "$field_name $data_type";
 303     $field_def .= $field->is_auto_increment ?
 304         ' GENERATED BY DEFAULT AS IDENTITY' : '';
 305     $field_def .= $data_type =~ /CHAR/i ? "(${size})" : '';
 306     $field_def .= !$field->is_nullable ? ' NOT NULL':'';
 307 #            $field_def .= $field->is_primary_key ? ' PRIMARY KEY':'';
 308     $field_def .= !defined $field->default_value ? '' :
 309         $field->default_value =~ /current( |_)timestamp/i ||
 310         $field->default_value =~ /\Qnow()\E/i ?
 311         'DEFAULT CURRENT TIMESTAMP' : defined $field->default_value ?
 312         (" DEFAULT '" .  $field->default_value . "'") : '';
 313
 314 }
 315
 316 sub create_index
 317 {
 318     my ($index) = @_;
 319
 320     my $out = sprintf('CREATE %sINDEX %s ON %s ( %s );',
 321                       $index->type() =~ /^UNIQUE$/i ? 'UNIQUE' : '',
 322                       $index->name,
 323                       $index->table->name,
 324                       join(', ', $index->fields) );
 325
 326     return $out;
 327 }
 328
 329 sub create_constraint
 330 {
 331     my ($constraint) = @_;
 332
 333     return '' if($constraint->type =~ /^PRIMARY(_|\s)KEY$/i);
 334
 335     my $ctype =  $constraint->type =~ /^PRIMARY(_|\s)KEY$/i ? 'PRIMARY KEY' :
 336                  $constraint->type =~ /^UNIQUE$/i      ? 'UNIQUE' :
 337                  $constraint->type =~ /^CHECK_C$/i     ? 'CHECK' :
 338                  $constraint->type =~ /^FOREIGN_KEY$/i ? 'FOREIGN KEY' : '';
 339
 340     my $expr = $constraint->type =~ /^CHECK_C$/i ? $constraint->expression :
 341         '';
 342     my $ref = $constraint->type =~ /^FOREIGN_KEY$/i ? ('REFERENCES ' . $constraint->reference_table . '(' . join(', ', $constraint->reference_fields) . ')') : '';
 343     my $update = $constraint->on_update ? $constraint->on_update : '';
 344     my $delete = $constraint->on_delete ? $constraint->on_delete : '';
 345
 346     my $out = sprintf('%s %s %s %s %s %s',
 347                       $constraint->name ? ('CONSTRAINT ' . $constraint->name) : '',
 348                       $ctype,
 349                       '(' . join (', ', $constraint->fields) . ')',
 350                       $expr ? $expr : $ref,
 351                       $update,
 352                       $delete);
 353
 354
 355     return $out;
 356
 357 }
 358
 359 sub create_view
 360 {
 361     my ($view) = @_;
 362
 363     my $out = sprintf("CREATE VIEW %s AS\n%s;",
 364                       $view->name,
 365                       $view->sql);
 366
 367     return $out;
 368 }
 369
 370 sub create_trigger
 371 {
 372     my ($trigger) = @_;
 373 # create: CREATE TRIGGER trigger_name before type /ON/i table_name reference_b(?) /FOR EACH ROW/i 'MODE DB2SQL' triggered_action
 374
 375     my $out = sprintf('CREATE TRIGGER %s %s %s ON %s %s %s MODE DB2SQL %s',
 376                       $trigger->name,
 377                       $trigger->perform_action_when || 'AFTER',
 378                       $trigger->database_event =~ /update_on/i ?
 379                         ('UPDATE OF '. join(', ', $trigger->fields)) :
 380                         $trigger->database_event || 'UPDATE',
 381                       $trigger->on_table->name,
 382                       $trigger->extra->{reference} || 'REFERENCING OLD AS oldrow NEW AS newrow',
 383                       $trigger->extra->{granularity} || 'FOR EACH ROW',
 384                       $trigger->action );
 385
 386     return $out;
 387
 388 }
 389
 390 sub alter_field
 391 {
 392     my ($from_field, $to_field) = @_;
 393 }
 394
 395 sub add_field
 396 {
 397     my ($field) = @_;
 398 }
 399
 400 sub drop_field
 401 {
 402     my ($field) = @_;
 403 }
 404 1;