[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / DB2.pm

package SQL::Translator::Producer::DB2;

# -------------------------------------------------------------------
# Copyright (C) 2002-2009 SQLFairy Authors
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; version 2.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307  USA
# -------------------------------------------------------------------
=head1 NAME

SQL::Translator::Producer::DB2 - DB2 SQL producer

=head1 SYNOPSIS

  use SQL::Translator;

  my $t = SQL::Translator->new( parser => '...', producer => 'DB2' );
  print $translator->translate( $file );

=head1 DESCRIPTION

Creates an SQL DDL suitable for DB2.

=cut

use warnings;
use strict;
use vars qw[ $VERSION $DEBUG $WARN ];
$VERSION = '1.59';
$DEBUG   = 0 unless defined $DEBUG;

use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(header_comment);


# http://publib.boulder.ibm.com/infocenter/db2help/topic/com.ibm.db2.udb.doc/ad/r0006844.htm

# This is a terrible WTDI, each Parser should parse down to some standard set
# of SQL data types, with field->extra entries being used to convert back to
# weird types like "polygon" if needed (IMO anyway)

my %dt_translate;
BEGIN {
  %dt_translate = (
    #
    # MySQL types
    #
    int        => 'integer',
    mediumint  => 'integer',
    tinyint    => 'smallint',
    char       => 'char',
    tinyblob   => 'blob',
    mediumblob => 'blob',
    longblob   => 'long varchar for bit data',
    tinytext   => 'varchar',
    text       => 'varchar',
    longtext   => 'varchar',
    mediumtext => 'varchar',
    enum       => 'varchar',
    set        => 'varchar',
    date       => 'date',
    datetime   => 'timestamp',
    time       => 'time',
    year       => 'date',

    #
    # PostgreSQL types
    #
    'double precision'  => 'double',
    serial              => 'integer',
    bigserial           => 'integer',
    money               => 'double',
    character           => 'char',
    'character varying' => 'varchar',
    bytea               => 'BLOB',
    interval            => 'integer',
    boolean             => 'smallint',
    point               => 'integer',
    line                => 'integer',
    lseg                => 'integer',
    box                 => 'integer',
    path                => 'integer',
    polygon             => 'integer',
    circle              => 'integer',
    cidr                => 'integer',
    inet                => 'varchar',
    macaddr             => 'varchar',
    bit                 => 'number',
    'bit varying'       => 'number',

    #
    # DB types
    #
    number              => 'integer',
    varchar2            => 'varchar',
    long                => 'clob',
);
}

my %db2_reserved = map { $_ => 1} qw/
ADD                DETERMINISTIC  LEAVE         RESTART
AFTER              DISALLOW       LEFT          RESTRICT
ALIAS              DISCONNECT     LIKE          RESULT
ALL                DISTINCT       LINKTYPE      RESULT_SET_LOCATOR
ALLOCATE           DO             LOCAL         RETURN
ALLOW              DOUBLE         LOCALE        RETURNS
ALTER              DROP           LOCATOR       REVOKE
AND                DSNHATTR       LOCATORS      RIGHT
ANY                DSSIZE         LOCK          ROLLBACK
APPLICATION        DYNAMIC        LOCKMAX       ROUTINE
AS                 EACH           LOCKSIZE      ROW
ASSOCIATE          EDITPROC       LONG          ROWS
ASUTIME            ELSE           LOOP          RRN
AUDIT              ELSEIF         MAXVALUE      RUN
AUTHORIZATION      ENCODING       MICROSECOND   SAVEPOINT
AUX                END            MICROSECONDS  SCHEMA
AUXILIARY          END-EXEC       MINUTE        SCRATCHPAD
BEFORE             END-EXEC1      MINUTES       SECOND
BEGIN              ERASE          MINVALUE      SECONDS
BETWEEN            ESCAPE         MODE          SECQTY
BINARY             EXCEPT         MODIFIES      SECURITY
BUFFERPOOL         EXCEPTION      MONTH         SELECT
BY                 EXCLUDING      MONTHS        SENSITIVE
CACHE              EXECUTE        NEW           SET
CALL               EXISTS         NEW_TABLE     SIGNAL
CALLED             EXIT           NO            SIMPLE
CAPTURE            EXTERNAL       NOCACHE       SOME
CARDINALITY        FENCED         NOCYCLE       SOURCE
CASCADED           FETCH          NODENAME      SPECIFIC
CASE               FIELDPROC      NODENUMBER    SQL
CAST               FILE           NOMAXVALUE    SQLID
CCSID              FINAL          NOMINVALUE    STANDARD
CHAR               FOR            NOORDER       START
CHARACTER          FOREIGN        NOT           STATIC
CHECK              FREE           NULL          STAY
CLOSE              FROM           NULLS         STOGROUP
CLUSTER            FULL           NUMPARTS      STORES
COLLECTION         FUNCTION       OBID          STYLE
COLLID             GENERAL        OF            SUBPAGES
COLUMN             GENERATED      OLD           SUBSTRING
COMMENT            GET            OLD_TABLE     SYNONYM
COMMIT             GLOBAL         ON            SYSFUN
CONCAT             GO             OPEN          SYSIBM
CONDITION          GOTO           OPTIMIZATION  SYSPROC
CONNECT            GRANT          OPTIMIZE      SYSTEM
CONNECTION         GRAPHIC        OPTION        TABLE
CONSTRAINT         GROUP          OR            TABLESPACE
CONTAINS           HANDLER        ORDER         THEN
CONTINUE           HAVING         OUT           TO
COUNT              HOLD           OUTER         TRANSACTION
COUNT_BIG          HOUR           OVERRIDING    TRIGGER
CREATE             HOURS          PACKAGE       TRIM
CROSS              IDENTITY       PARAMETER     TYPE
CURRENT            IF             PART          UNDO
CURRENT_DATE       IMMEDIATE      PARTITION     UNION
CURRENT_LC_CTYPE   IN             PATH          UNIQUE
CURRENT_PATH       INCLUDING      PIECESIZE     UNTIL
CURRENT_SERVER     INCREMENT      PLAN          UPDATE
CURRENT_TIME       INDEX          POSITION      USAGE
CURRENT_TIMESTAMP  INDICATOR      PRECISION     USER
CURRENT_TIMEZONE   INHERIT        PREPARE       USING
CURRENT_USER       INNER          PRIMARY       VALIDPROC
CURSOR             INOUT          PRIQTY        VALUES
CYCLE              INSENSITIVE    PRIVILEGES    VARIABLE
DATA               INSERT         PROCEDURE     VARIANT
DATABASE           INTEGRITY      PROGRAM       VCAT
DAY                INTO           PSID          VIEW
DAYS               IS             QUERYNO       VOLUMES
DB2GENERAL         ISOBID         READ          WHEN
DB2GENRL           ISOLATION      READS         WHERE
DB2SQL             ITERATE        RECOVERY      WHILE
DBINFO             JAR            REFERENCES    WITH
DECLARE            JAVA           REFERENCING   WLM
DEFAULT            JOIN           RELEASE       WRITE
DEFAULTS           KEY            RENAME        YEAR
DEFINITION         LABEL          REPEAT        YEARS
DELETE             LANGUAGE       RESET
DESCRIPTOR         LC_CTYPE       RESIGNAL
/;

sub produce
{
    my ($translator) = @_;
    $DEBUG             = $translator->debug;
    $WARN              = $translator->show_warnings;
    my $no_comments    = $translator->no_comments;
    my $add_drop_table = $translator->add_drop_table;
    my $schema         = $translator->schema;
    my $output         = '';
    my $indent         = '    ';

    $output .= header_comment unless($no_comments);
    my (@table_defs, @fks, @index_defs);
    foreach my $table ($schema->get_tables)
    {
        push @table_defs, 'DROP TABLE ' . $table->name . ";" if $add_drop_table;
        my ($table_def, $fks) = create_table($table, {
            no_comments => $no_comments});
        push @table_defs, $table_def;
        push @fks, @$fks;

        foreach my $index ($table->get_indices)
        {
            push @index_defs, create_index($index);
        }

    }
    my (@view_defs);
    foreach my $view ( $schema->get_views )
    {
        push @view_defs, create_view($view);
    }
    my (@trigger_defs);
    foreach my $trigger ( $schema->get_triggers )
    {
        push @trigger_defs, create_trigger($trigger);
    }

    return wantarray ? (@table_defs, @fks, @index_defs, @view_defs, @trigger_defs) :
        $output . join("\n\n", @table_defs, @fks, @index_defs, @view_defs, @trigger_defs) . "\n";
}

{ my %objnames;

    sub check_name
    {
        my ($name, $type, $length) = @_;

        my $newname = $name;
        if(length($name) > $length)   ## Maximum table name length is 18
        {
            warn "Table name $name is longer than $length characters, truncated" if $WARN;
#             if(grep {$_ eq substr($name, 0, $length) }
#                               values(%{$objnames{$type}}))
#             {
#                 die "Got multiple matching table names when truncated";
#             }
#             $objnames{$type}{$name} = substr($name, 0,$length);
#             $newname = $objnames{$type}{$name};
        }

        if($db2_reserved{uc($newname)})
        {
            warn "$newname is a reserved word in DB2!" if $WARN;
        }

#        return sprintf("%-*s", $length-5, $newname);
        return $newname;
    }
}

sub create_table
{
    my ($table, $options) = @_;

    my $table_name = check_name($table->name, 'tables', 128);
    # this limit is 18 in older DB2s ! (<= 8)

    my (@field_defs, @comments);
    push @comments, "--\n-- Table: $table_name\n--" unless $options->{no_comments};
    foreach my $field ($table->get_fields)
    {
        push @field_defs, create_field($field);
    }
    my (@con_defs, @fks);
    foreach my $con ($table->get_constraints)
    {
        my ($cdefs, $fks) = create_constraint($con);
        push @con_defs, @$cdefs;
        push @fks, @$fks;
    }

    my $tablespace = $table->extra()->{'TABLESPACE'} || '';
    my $table_def = "CREATE TABLE $table_name (\n";
    $table_def .= join (",\n", map { "  $_" } @field_defs, @con_defs);
    $table_def .= "\n)";
    $table_def .= $tablespace ? "IN $tablespace;" : ';';

    return $table_def, \@fks;
}

sub create_field
{
    my ($field) = @_;

    my $field_name = check_name($field->name, 'fields', 30);
#    use Data::Dumper;
#    print Dumper(\%dt_translate);
#    print $field->data_type, " ", $dt_translate{lc($field->data_type)}, "\n";
    my $data_type = uc($dt_translate{lc($field->data_type)} || $field->data_type);
    my $size = $field->size();

    my $field_def = "$field_name $data_type";
    $field_def .= $field->is_auto_increment ?
        ' GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1)' : '';
    $field_def .= $data_type =~ /(CHAR|CLOB|NUMERIC|DECIMAL)/i ? "(${size})" : '';
    $field_def .= !$field->is_nullable ? ' NOT NULL':'';
#            $field_def .= $field->is_primary_key ? ' PRIMARY KEY':'';
    $field_def .= !defined $field->default_value ? '' :
        $field->default_value =~ /current( |_)timestamp/i ||
        $field->default_value =~ /\Qnow()\E/i ?
        ' DEFAULT CURRENT TIMESTAMP' : defined $field->default_value ?
        (" DEFAULT " . ($data_type =~ /(INT|DOUBLE)/i ?
                        $field->default_value : "'" . $field->default_value . "'")
         ) : '';

    return $field_def;
}

sub create_index
{
    my ($index) = @_;

    my $out = sprintf('CREATE %sINDEX %s ON %s ( %s );',
                      $index->type() =~ /^UNIQUE$/i ? 'UNIQUE' : '',
                      $index->name,
                      $index->table->name,
                      join(', ', $index->fields) );

    return $out;
}

sub create_constraint
{
    my ($constraint) = @_;

    my (@con_defs, @fks);

    my $ctype =  $constraint->type =~ /^PRIMARY(_|\s)KEY$/i ? 'PRIMARY KEY' :
                 $constraint->type =~ /^UNIQUE$/i      ? 'UNIQUE' :
                 $constraint->type =~ /^CHECK_C$/i     ? 'CHECK' :
                 $constraint->type =~ /^FOREIGN(_|\s)KEY$/i ? 'FOREIGN KEY' : '';

    my $expr = $constraint->type =~ /^CHECK_C$/i ? $constraint->expression :
        '';
    my $ref = $constraint->type =~ /^FOREIGN(_|\s)KEY$/i ? ('REFERENCES ' . $constraint->reference_table . '(' . join(', ', $constraint->reference_fields) . ')') : '';
    my $update = $constraint->on_update ? $constraint->on_update : '';
    my $delete = $constraint->on_delete ? $constraint->on_delete : '';

    my $out = join(' ', grep { $_ }
                      $constraint->name ? ('CONSTRAINT ' . $constraint->name) : '',
                      $ctype,
                      '(' . join (', ', $constraint->fields) . ')',
                      $expr ? $expr : $ref,
                      $update,
                      $delete);
    if ($constraint->type eq FOREIGN_KEY) {
        my $table_name = $constraint->table->name;
        $out = "ALTER TABLE $table_name ADD $out;";
        push @fks, $out;
    }
    else {
        push @con_defs, $out;
    }

    return \@con_defs, \@fks;

}

sub create_view
{
    my ($view) = @_;

    my $out = sprintf("CREATE VIEW %s AS\n%s;",
                      $view->name,
                      $view->sql);

    return $out;
}

sub create_trigger
{
    my ($trigger) = @_;
# create: CREATE TRIGGER trigger_name before type /ON/i table_name reference_b(?) /FOR EACH ROW/i 'MODE DB2SQL' triggered_action

    my $db_events = join ', ', $trigger->database_events;
    my $out = sprintf('CREATE TRIGGER %s %s %s ON %s %s %s MODE DB2SQL %s',
                      $trigger->name,
                      $trigger->perform_action_when || 'AFTER',
                      $db_events =~ /update_on/i ?
                        ('UPDATE OF '. join(', ', $trigger->fields)) :
                        $db_events || 'UPDATE',
                      $trigger->table->name,
                      $trigger->extra->{reference} || 'REFERENCING OLD AS oldrow NEW AS newrow',
                      $trigger->extra->{granularity} || 'FOR EACH ROW',
                      $trigger->action );

    return $out;

}

sub alter_field
{
    my ($from_field, $to_field) = @_;

    my $data_type = uc($dt_translate{lc($to_field->data_type)} || $to_field->data_type);

    my $size = $to_field->size();
    $data_type .= $data_type =~ /CHAR/i ? "(${size})" : '';

    # DB2 will only allow changing of varchar/vargraphic datatypes
    # to extend their lengths. Or changing of text types to other
    # texttypes, and numeric types to larger numeric types. (v8)
    # We can also drop/add keys, checks and constraints, but not
    # columns !?

    my $out = sprintf('ALTER TABLE %s ALTER %s SET DATATYPE %s',
                      $to_field->table->name,
                      $to_field->name,
                      $data_type);

}

sub add_field
{
    my ($new_field) = @_;

    my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
                      $new_field->table->name,
                      create_field($new_field));

    return $out;
}

sub drop_field
{
    my ($field) = @_;

    return '';
}
1;
Commit	Line	Data
04bc93b6	1	package SQL::Translator::Producer::DB2;
04bc93b6	2
44659089	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	# -------------------------------------------------------------------
04bc93b6	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
a0ea6c87	33	Creates an SQL DDL suitable for DB2.
04bc93b6	34
	35	=cut
	36
a0ea6c87	37	use warnings;
04bc93b6	38	use strict;
da06ac74	39	use vars qw[ $VERSION $DEBUG $WARN ];
11ad2df9	40	$VERSION = '1.59';
04bc93b6	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
3866f0ff	53	my %dt_translate;
5e2c196a	54	BEGIN {
5e2c196a	55	%dt_translate = (
04bc93b6	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',
a0ea6c87	67	text => 'varchar',
	68	longtext => 'varchar',
	69	mediumtext => 'varchar',
04bc93b6	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	);
5e2c196a	109	}
04bc93b6	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
ea93df61	189	DESCRIPTOR LC_CTYPE RESIGNAL
04bc93b6	190	/;
04bc93b6	191
04bc93b6	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);
b08b5416	204	my (@table_defs, @fks, @index_defs);
04bc93b6	205	foreach my $table ($schema->get_tables)
04bc93b6	206	{
5e2c196a	207	push @table_defs, 'DROP TABLE ' . $table->name . ";" if $add_drop_table;
b08b5416	208	my ($table_def, $fks) = create_table($table, {
a0ea6c87	209	no_comments => $no_comments});
b08b5416	210	push @table_defs, $table_def;
b08b5416	211	push @fks, @$fks;
04bc93b6	212
a0ea6c87	213	foreach my $index ($table->get_indices)
04bc93b6	214	{
a0ea6c87	215	push @index_defs, create_index($index);
04bc93b6	216	}
a0ea6c87	217
ea93df61	218	}
a0ea6c87	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	}
04bc93b6	229
b08b5416	230	return wantarray ? (@table_defs, @fks, @index_defs, @view_defs, @trigger_defs) :
b08b5416	231	$output . join("\n\n", @table_defs, @fks, @index_defs, @view_defs, @trigger_defs) . "\n";
04bc93b6	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;
ea93df61	244	# if(grep {$_ eq substr($name, 0, $length) }
a0ea6c87	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};
04bc93b6	251	}
	252
	253	if($db2_reserved{uc($newname)})
	254	{
	255	warn "$newname is a reserved word in DB2!" if $WARN;
	256	}
	257
5e2c196a	258	# return sprintf("%-*s", $length-5, $newname);
5e2c196a	259	return $newname;
04bc93b6	260	}
	261	}
	262
a0ea6c87	263	sub create_table
	264	{
	265	my ($table, $options) = @_;
	266
ea93df61	267	my $table_name = check_name($table->name, 'tables', 128);
a0ea6c87	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	}
b08b5416	276	my (@con_defs, @fks);
a0ea6c87	277	foreach my $con ($table->get_constraints)
a0ea6c87	278	{
b08b5416	279	my ($cdefs, $fks) = create_constraint($con);
	280	push @con_defs, @$cdefs;
	281	push @fks, @$fks;
a0ea6c87	282	}
a0ea6c87	283
	284	my $tablespace = $table->extra()->{'TABLESPACE'} \|\| '';
	285	my $table_def = "CREATE TABLE $table_name (\n";
b08b5416	286	$table_def .= join (",\n", map { " $_" } @field_defs, @con_defs);
a0ea6c87	287	$table_def .= "\n)";
	288	$table_def .= $tablespace ? "IN $tablespace;" : ';';
	289
b08b5416	290	return $table_def, \@fks;
a0ea6c87	291	}
	292
	293	sub create_field
	294	{
	295	my ($field) = @_;
ea93df61	296
a0ea6c87	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";
ea93df61	305	$field_def .= $field->is_auto_increment ?
3866f0ff	306	' GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1)' : '';
5ca2365a	307	$field_def .= $data_type =~ /(CHAR\|CLOB\|NUMERIC\|DECIMAL)/i ? "(${size})" : '';
a0ea6c87	308	$field_def .= !$field->is_nullable ? ' NOT NULL':'';
a0ea6c87	309	# $field_def .= $field->is_primary_key ? ' PRIMARY KEY':'';
ea93df61	310	$field_def .= !defined $field->default_value ? '' :
a0ea6c87	311	$field->default_value =~ /current( \|_)timestamp/i \|\|
ea93df61	312	$field->default_value =~ /\Qnow()\E/i ?
b08b5416	313	' DEFAULT CURRENT TIMESTAMP' : defined $field->default_value ?
ea93df61	314	(" DEFAULT " . ($data_type =~ /(INT\|DOUBLE)/i ?
b08b5416	315	$field->default_value : "'" . $field->default_value . "'")
b08b5416	316	) : '';
a0ea6c87	317
5e2c196a	318	return $field_def;
a0ea6c87	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
b08b5416	338	my (@con_defs, @fks);
a0ea6c87	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' :
b08b5416	343	$constraint->type =~ /^FOREIGN(_\|\s)KEY$/i ? 'FOREIGN KEY' : '';
a0ea6c87	344
	345	my $expr = $constraint->type =~ /^CHECK_C$/i ? $constraint->expression :
	346	'';
b08b5416	347	my $ref = $constraint->type =~ /^FOREIGN(_\|\s)KEY$/i ? ('REFERENCES ' . $constraint->reference_table . '(' . join(', ', $constraint->reference_fields) . ')') : '';
a0ea6c87	348	my $update = $constraint->on_update ? $constraint->on_update : '';
	349	my $delete = $constraint->on_delete ? $constraint->on_delete : '';
	350
b08b5416	351	my $out = join(' ', grep { $_ }
a0ea6c87	352	$constraint->name ? ('CONSTRAINT ' . $constraint->name) : '',
	353	$ctype,
	354	'(' . join (', ', $constraint->fields) . ')',
	355	$expr ? $expr : $ref,
	356	$update,
	357	$delete);
b08b5416	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	}
a0ea6c87	366
b08b5416	367	return \@con_defs, \@fks;
ea93df61	368
a0ea6c87	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
df78f12b	387	my $db_events = join ', ', $trigger->database_events;
a0ea6c87	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',
ea93df61	391	$db_events =~ /update_on/i ?
a0ea6c87	392	('UPDATE OF '. join(', ', $trigger->fields)) :
df78f12b	393	$db_events \|\| 'UPDATE',
5e2c196a	394	$trigger->table->name,
a0ea6c87	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;
ea93df61	400
a0ea6c87	401	}
	402
	403	sub alter_field
	404	{
	405	my ($from_field, $to_field) = @_;
5e2c196a	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
a0ea6c87	423	}
	424
	425	sub add_field
	426	{
5e2c196a	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;
a0ea6c87	434	}
	435
	436	sub drop_field
	437	{
	438	my ($field) = @_;
5e2c196a	439
5e2c196a	440	return '';
a0ea6c87	441	}
04bc93b6	442	1;