Upped version numbers, cleaned up code, fixed my name.
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / DB2.pm
index c394201..e71e9e7 100644 (file)
@@ -1,9 +1,7 @@
 package SQL::Translator::Producer::DB2;
 
 # -------------------------------------------------------------------
-# $Id: DB2.pm,v 1.1 2005-09-18 20:06:31 schiffbruechige Exp $
-# -------------------------------------------------------------------
-# Copyright (C) 2002-4 SQLFairy Authors
+# 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
@@ -19,7 +17,6 @@ package SQL::Translator::Producer::DB2;
 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
 # 02111-1307  USA
 # -------------------------------------------------------------------
-
 =head1 NAME
 
 SQL::Translator::Producer::DB2 - DB2 SQL producer
@@ -33,13 +30,14 @@ SQL::Translator::Producer::DB2 - DB2 SQL producer
 
 =head1 DESCRIPTION
 
-Creates an SQL DDL suitable for DB.
+Creates an SQL DDL suitable for DB2.
 
 =cut
 
+use warnings;
 use strict;
 use vars qw[ $VERSION $DEBUG $WARN ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/;
+$VERSION = '1.60';
 $DEBUG   = 0 unless defined $DEBUG;
 
 use SQL::Translator::Schema::Constants;
@@ -52,7 +50,9 @@ use SQL::Translator::Utils qw(header_comment);
 # of SQL data types, with field->extra entries being used to convert back to
 # weird types like "polygon" if needed (IMO anyway)
 
-my %translate  = (
+my %dt_translate;
+BEGIN {
+  %dt_translate = (
     #
     # MySQL types
     #
@@ -64,9 +64,9 @@ my %translate  = (
     mediumblob => 'blob',
     longblob   => 'long varchar for bit data',
     tinytext   => 'varchar',
-    text       => 'clob',
-    longtext   => 'clob',
-    mediumtext => 'clob',
+    text       => 'varchar',
+    longtext   => 'varchar',
+    mediumtext => 'varchar',
     enum       => 'varchar',
     set        => 'varchar',
     date       => 'date',
@@ -106,6 +106,7 @@ my %translate  = (
     varchar2            => 'varchar',
     long                => 'clob',
 );
+}
 
 my %db2_reserved = map { $_ => 1} qw/
 ADD                DETERMINISTIC  LEAVE         RESTART
@@ -202,42 +203,34 @@ sub produce
     my $indent         = '    ';
 
     $output .= header_comment unless($no_comments);
-    my (@table_defs);
+    my (@table_defs, @fks, @index_defs);
     foreach my $table ($schema->get_tables)
     {
-        my $table_name = check_name($table->name, 'tables', 18);
+        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;
 
-        my (@field_defs, @comments);
-        push @comments, "--\n-- Table: $table_name\n--" unless $no_comments;
-        foreach my $field ($table->get_fields)
+        foreach my $index ($table->get_indices)
         {
-            my $field_name = check_name($field->name, 'fields', 30);
-            my $data_type = uc($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' : '';
-            $field_def .= $data_type =~ /CHAR/i ? "(${size})" : '';
-            $field_def .= !$field->is_nullable ? ' NOT NULL':'';
-            $field_def .= $field->is_primary_key ? ' PRIMARY KEY':'';
-            $field_def .= $field->default_value ? ' DEFAULT ' .  $field->default_value : '';
-
-            push @field_defs, "${indent}${field_def}";
+            push @index_defs, create_index($index);
         }
-        
-
-        my $tablespace = $table->extra()->{'TABLESPACE'} || '';
-        my $table_def = "CREATE TABLE $table_name (\n";
-        $table_def .= join (",\n", @field_defs);
-        $table_def .= "\n)";
-        $table_def .= $tablespace ? "IN $tablespace;" : ';';
-        
-        push @table_defs, "DROP TABLE $table_name;\n" if $add_drop_table;
-        push @table_defs, $table_def;
+
     }   
+    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);
+    }
 
-    $output .= join("\n\n", @table_defs);
+    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;
@@ -250,13 +243,13 @@ sub produce
         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(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)})
@@ -264,8 +257,188 @@ sub produce
             warn "$newname is a reserved word in DB2!" if $WARN;
         }
 
-        return sprintf("%-*s", $length-5, $newname);
+#        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)/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;