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

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

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