lib/SQL/Translator/Parser/DBI/DB2.pm

   1 package SQL::Translator::Parser::DBI::DB2;
   2
   3 =head1 NAME
   4
   5 SQL::Translator::Parser::DBI::DB2 - parser for DBD::DB2
   6
   7 =head1 SYNOPSIS
   8
   9 See SQL::Translator::Parser::DBI.
  10
  11 =head1 DESCRIPTION
  12
  13 Uses DBI methods to determine schema structure.  DBI, of course,
  14 delegates to DBD::DB2.
  15
  16 =cut
  17
  18 use strict;
  19 use DBI;
  20 use Data::Dumper;
  21 use SQL::Translator::Parser::DB2;
  22 use SQL::Translator::Schema::Constants;
  23
  24 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
  25 # $VERSION = '1.59';
  26 $DEBUG   = 0 unless defined $DEBUG;
  27
  28 sub parse {
  29     my ( $tr, $dbh ) = @_;
  30
  31     my $schema = $tr->schema;
  32
  33     my ($sth, @tables, $columns);
  34     my $stuff;
  35
  36     if ($dbh->{FetchHashKeyName} ne 'NAME_uc') {
  37         $dbh->{FetchHashKeyName} = 'NAME_uc';
  38     }
  39
  40     if ($dbh->{ChopBlanks} != 1) {
  41         $dbh->{ChopBlanks} = 1;
  42     }
  43
  44     my $tabsth = $dbh->prepare(<<SQL);
  45 SELECT t.TABSCHEMA,
  46        t.TABNAME,
  47        t.TYPE,
  48       ts.TBSPACE
  49 FROM SYSCAT.TABLES t
  50 JOIN SYSCAT.TABLESPACES ts ON t.TBSPACEID = ts.TBSPACEID
  51 WHERE t.TABSCHEMA NOT LIKE 'SYS%'
  52 ORDER BY t.TABNAME ASC
  53 SQL
  54 #    $sth = $dbh->table_info();
  55 #    @tables   = @{$sth->fetchall_arrayref({})};
  56
  57     my $colsth = $dbh->prepare(<<SQL);
  58 SELECT c.TABSCHEMA,
  59        c.TABNAME,
  60        c.COLNAME,
  61        c.TYPENAME,
  62        c.LENGTH,
  63        c.DEFAULT,
  64        c.NULLS,
  65        c.COLNO
  66 FROM SYSCAT.COLUMNS c
  67 WHERE c.TABSCHEMA NOT LIKE 'SYS%' AND
  68      c.TABNAME = ?
  69 ORDER BY COLNO
  70 SQL
  71
  72     my $consth = $dbh->prepare(<<SQL);
  73 SELECT tc.TABSCHEMA,
  74        tc.TABNAME,
  75        kc.CONSTNAME,
  76        kc.COLNAME,
  77        tc.TYPE,
  78        tc.CHECKEXISTINGDATA
  79 FROM SYSCAT.TABCONST tc
  80 JOIN SYSCAT.KEYCOLUSE kc ON tc.CONSTNAME = kc.CONSTNAME AND
  81                             tc.TABSCHEMA = kc.TABSCHEMA AND
  82                             tc.TABNAME   = kc.TABNAME
  83 WHERE tc.TABSCHEMA NOT LIKE 'SYS%' AND
  84       tc.TABNAME = ?
  85 SQL
  86
  87     my $indsth = $dbh->prepare(<<SQL);
  88 SELECT i.INDSCHEMA,
  89        i.INDNAME,
  90        i.TABSCHEMA,
  91        i.TABNAME,
  92        i.UNIQUERULE,
  93        i.INDEXTYPE,
  94        ic.COLNAME
  95 FROM SYSCAT.INDEXES i
  96 JOIN SYSCAT.INDEXCOLUSE ic ON i.INDSCHEMA = ic.INDSCHEMA AND
  97                               i.INDNAME = ic.INDNAME
  98 WHERE i.TABSCHEMA NOT LIKE 'SYS%' AND
  99       i.INDEXTYPE <> 'P' AND
 100       i.TABNAME = ?
 101 SQL
 102
 103     my $trigsth = $dbh->prepare(<<SQL);
 104 SELECT t.TRIGSCHEMA,
 105        t.TRIGNAME,
 106        t.TABSCHEMA,
 107        t.TRIGTIME,
 108        t.TRIGEVENT,
 109        t.GRANULARITY,
 110        t.TEXT
 111 FROM SYSCAT.TRIGGERS t
 112 WHERE t.TABSCHEMA NOT LIKE 'SYS%' AND
 113       t.TABNAME = ?
 114 SQL
 115
 116     $tabsth->execute();
 117     @tables = @{$tabsth->fetchall_arrayref({})};
 118
 119     foreach my $table_info (@tables) {
 120         next
 121             unless (defined($table_info->{TYPE}));
 122
 123 # Why are we not getting system tables, maybe a parameter should decide?
 124
 125         if ($table_info->{TYPE} eq 'T'&&
 126             $table_info->{TABSCHEMA} !~ /^SYS/) {
 127             print Dumper($table_info) if($DEBUG);
 128             print  $table_info->{TABNAME} if($DEBUG);
 129             my $table = $schema->add_table(
 130                                            name => $table_info->{TABNAME},
 131                                            type => 'TABLE',
 132                                           ) || die $schema->error;
 133             $table->options("TABLESPACE", $table_info->{TBSPACE});
 134
 135             $colsth->execute($table_info->{TABNAME});
 136             my $cols = $colsth->fetchall_hashref("COLNAME");
 137
 138             foreach my $c (values %{$cols}) {
 139                 print Dumper($c) if $DEBUG;
 140                 print $c->{COLNAME} if($DEBUG);
 141                 my $f = $table->add_field(
 142                                         name        => $c->{COLNAME},
 143                                         default_value => $c->{DEFAULT},
 144                                         data_type   => $c->{TYPENAME},
 145                                         order       => $c->{COLNO},
 146                                         size        => $c->{LENGTH},
 147                                          ) || die $table->error;
 148
 149
 150                 $f->is_nullable($c->{NULLS} eq 'Y');
 151             }
 152
 153             $consth->execute($table_info->{TABNAME});
 154             my $cons = $consth->fetchall_hashref("COLNAME");
 155             next if(!%$cons);
 156
 157             my @fields = map { $_->{COLNAME} } (values %{$cons});
 158             my $c = $cons->{$fields[0]};
 159
 160             print  $c->{CONSTNAME} if($DEBUG);
 161             my $con = $table->add_constraint(
 162                                            name   => $c->{CONSTNAME},
 163                                            fields => \@fields,
 164                                            type   => $c->{TYPE} eq 'P' ?
 165                                            PRIMARY_KEY : $c->{TYPE} eq 'F' ?
 166                                            FOREIGN_KEY : UNIQUE
 167                                          ) || die $table->error;
 168
 169
 170             $con->deferrable($c->{CHECKEXISTINGDATA} eq 'D');
 171
 172             $indsth->execute($table_info->{TABNAME});
 173             my $inds = $indsth->fetchall_hashref("INDNAME");
 174             print Dumper($inds) if($DEBUG);
 175             next if(!%$inds);
 176
 177             foreach my $ind (keys %$inds)
 178             {
 179                 print $ind if($DEBUG);
 180                 $indsth->execute($table_info->{TABNAME});
 181                 my $indcols = $indsth->fetchall_hashref("COLNAME");
 182                 next if($inds->{$ind}{UNIQUERULE} eq 'P');
 183
 184                 print Dumper($indcols) if($DEBUG);
 185
 186                 my @fields = map { $_->{INDNAME} eq $ind ? $_->{COLNAME} : () }
 187                    (values %{$indcols});
 188
 189                 my $index = $indcols->{$fields[0]};
 190
 191                 my $inew = $table->add_index(
 192                                              name   => $index->{INDNAME},
 193                                              fields => \@fields,
 194                                              type   => $index->{UNIQUERULE} eq 'U' ?
 195                                              UNIQUE : NORMAL
 196                                              ) || die $table->error;
 197
 198
 199             }
 200
 201             $trigsth->execute($table_info->{TABNAME});
 202             my $trigs = $trigsth->fetchall_hashref("TRIGNAME");
 203             print Dumper($trigs);
 204             next if(!%$trigs);
 205
 206             foreach my $t (values %$trigs)
 207             {
 208                 print  $t->{TRIGNAME} if($DEBUG);
 209                 my $trig = $schema->add_trigger(
 210                      name                  => $t->{TRIGNAME},
 211  #                      fields => \@fields,
 212                      perform_action_when   => $t->{TRIGTIME} eq 'A' ? 'after' :
 213                                               $t->{TRIGTIME} eq 'B' ? 'before':
 214                                               'instead',
 215                      database_event        => $t->{TRIGEVENT} eq 'I' ? 'insert'
 216                                             : $t->{TRIGEVENT} eq 'D' ? 'delete'
 217                                             : 'update',
 218                      action                => $t->{TEXT},
 219                      on_table              => $t->{TABNAME}
 220                                               ) || die $schema->error;
 221
 222 #             $trig->extra( reference => $def->{'reference'},
 223 #                           condition => $def->{'condition'},
 224 #                           granularity => $def->{'granularity'} );
 225             }
 226
 227         }
 228     }
 229
 230     return 1;
 231 }
 232
 233 1;
 234
 235 # -------------------------------------------------------------------
 236 # Time is a waste of money.
 237 # Oscar Wilde
 238 # -------------------------------------------------------------------
 239
 240 =pod
 241
 242 =head1 AUTHOR
 243
 244 Jess Robinson <lt>castaway@desert-island.m.isar.de<gt>.
 245
 246 =head1 SEE ALSO
 247
 248 SQL::Translator, DBD::DB2.
 249
 250 =cut