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