1 package SQL::Translator::Parser::DBI::DB2;
5 SQL::Translator::Parser::DBI::DB2 - parser for DBD::DB2
9 See SQL::Translator::Parser::DBI.
13 Uses DBI methods to determine schema structure. DBI, of course,
14 delegates to DBD::DB2.
21 use SQL::Translator::Parser::DB2;
22 use SQL::Translator::Schema::Constants;
24 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
25 # $VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
26 $DEBUG = 0 unless defined $DEBUG;
28 # -------------------------------------------------------------------
30 my ( $tr, $dbh ) = @_;
32 my $schema = $tr->schema;
34 my ($sth, @tables, $columns);
37 if ($dbh->{FetchHashKeyName} ne 'NAME_uc') {
38 $dbh->{FetchHashKeyName} = 'NAME_uc';
41 if ($dbh->{ChopBlanks} != 1) {
42 $dbh->{ChopBlanks} = 1;
45 my $tabsth = $dbh->prepare(<<SQL);
51 JOIN SYSCAT.TABLESPACES ts ON t.TBSPACEID = ts.TBSPACEID
52 WHERE t.TABSCHEMA NOT LIKE 'SYS%'
53 ORDER BY t.TABNAME ASC
55 # $sth = $dbh->table_info();
56 # @tables = @{$sth->fetchall_arrayref({})};
58 my $colsth = $dbh->prepare(<<SQL);
68 WHERE c.TABSCHEMA NOT LIKE 'SYS%' AND
73 my $consth = $dbh->prepare(<<SQL);
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
88 my $indsth = $dbh->prepare(<<SQL);
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
104 my $trigsth = $dbh->prepare(<<SQL);
112 FROM SYSCAT.TRIGGERS t
113 WHERE t.TABSCHEMA NOT LIKE 'SYS%' AND
118 @tables = @{$tabsth->fetchall_arrayref({})};
120 foreach my $table_info (@tables) {
122 unless (defined($table_info->{TYPE}));
124 # Why are we not getting system tables, maybe a parameter should decide?
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},
133 ) || die $schema->error;
134 $table->options("TABLESPACE", $table_info->{TBSPACE});
136 $colsth->execute($table_info->{TABNAME});
137 my $cols = $colsth->fetchall_hashref("COLNAME");
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;
151 $f->is_nullable($c->{NULLS} eq 'Y');
154 $consth->execute($table_info->{TABNAME});
155 my $cons = $consth->fetchall_hashref("COLNAME");
158 my @fields = map { $_->{COLNAME} } (values %{$cons});
159 my $c = $cons->{$fields[0]};
161 print $c->{CONSTNAME} if($DEBUG);
162 my $con = $table->add_constraint(
163 name => $c->{CONSTNAME},
165 type => $c->{TYPE} eq 'P' ?
166 PRIMARY_KEY : $c->{TYPE} eq 'F' ?
168 ) || die $table->error;
171 $con->deferrable($c->{CHECKEXISTINGDATA} eq 'D');
173 $indsth->execute($table_info->{TABNAME});
174 my $inds = $indsth->fetchall_hashref("INDNAME");
175 print Dumper($inds) if($DEBUG);
178 foreach my $ind (keys %$inds)
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');
185 print Dumper($indcols) if($DEBUG);
187 my @fields = map { $_->{INDNAME} eq $ind ? $_->{COLNAME} : () }
188 (values %{$indcols});
190 my $index = $indcols->{$fields[0]};
192 my $inew = $table->add_index(
193 name => $index->{INDNAME},
195 type => $index->{UNIQUERULE} eq 'U' ?
197 ) || die $table->error;
202 $trigsth->execute($table_info->{TABNAME});
203 my $trigs = $trigsth->fetchall_hashref("TRIGNAME");
204 print Dumper($trigs);
207 foreach my $t (values %$trigs)
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':
216 database_event => $t->{TRIGEVENT} eq 'I' ? 'insert'
217 : $t->{TRIGEVENT} eq 'D' ? 'delete'
219 action => $t->{TEXT},
220 on_table => $t->{TABNAME}
221 ) || die $schema->error;
223 # $trig->extra( reference => $def->{'reference'},
224 # condition => $def->{'condition'},
225 # granularity => $def->{'granularity'} );
236 # -------------------------------------------------------------------
237 # Time is a waste of money.
239 # -------------------------------------------------------------------
245 Jess Robinson <lt>castaway@desert-island.m.isar.de<gt>.
249 SQL::Translator, DBD::DB2.