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