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 ];
26 $DEBUG = 0 unless defined $DEBUG;
29 my ( $tr, $dbh ) = @_;
31 my $schema = $tr->schema;
33 my ($sth, @tables, $columns);
36 if ($dbh->{FetchHashKeyName} ne 'NAME_uc') {
37 $dbh->{FetchHashKeyName} = 'NAME_uc';
40 if ($dbh->{ChopBlanks} != 1) {
41 $dbh->{ChopBlanks} = 1;
44 my $tabsth = $dbh->prepare(<<SQL);
50 JOIN SYSCAT.TABLESPACES ts ON t.TBSPACEID = ts.TBSPACEID
51 WHERE t.TABSCHEMA NOT LIKE 'SYS%'
52 ORDER BY t.TABNAME ASC
54 # $sth = $dbh->table_info();
55 # @tables = @{$sth->fetchall_arrayref({})};
57 my $colsth = $dbh->prepare(<<SQL);
67 WHERE c.TABSCHEMA NOT LIKE 'SYS%' AND
72 my $consth = $dbh->prepare(<<SQL);
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
87 my $indsth = $dbh->prepare(<<SQL);
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
103 my $trigsth = $dbh->prepare(<<SQL);
111 FROM SYSCAT.TRIGGERS t
112 WHERE t.TABSCHEMA NOT LIKE 'SYS%' AND
117 @tables = @{$tabsth->fetchall_arrayref({})};
119 foreach my $table_info (@tables) {
121 unless (defined($table_info->{TYPE}));
123 # Why are we not getting system tables, maybe a parameter should decide?
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},
132 ) || die $schema->error;
133 $table->options("TABLESPACE", $table_info->{TBSPACE});
135 $colsth->execute($table_info->{TABNAME});
136 my $cols = $colsth->fetchall_hashref("COLNAME");
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;
150 $f->is_nullable($c->{NULLS} eq 'Y');
153 $consth->execute($table_info->{TABNAME});
154 my $cons = $consth->fetchall_hashref("COLNAME");
157 my @fields = map { $_->{COLNAME} } (values %{$cons});
158 my $c = $cons->{$fields[0]};
160 print $c->{CONSTNAME} if($DEBUG);
161 my $con = $table->add_constraint(
162 name => $c->{CONSTNAME},
164 type => $c->{TYPE} eq 'P' ?
165 PRIMARY_KEY : $c->{TYPE} eq 'F' ?
167 ) || die $table->error;
170 $con->deferrable($c->{CHECKEXISTINGDATA} eq 'D');
172 $indsth->execute($table_info->{TABNAME});
173 my $inds = $indsth->fetchall_hashref("INDNAME");
174 print Dumper($inds) if($DEBUG);
177 foreach my $ind (keys %$inds)
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');
184 print Dumper($indcols) if($DEBUG);
186 my @fields = map { $_->{INDNAME} eq $ind ? $_->{COLNAME} : () }
187 (values %{$indcols});
189 my $index = $indcols->{$fields[0]};
191 my $inew = $table->add_index(
192 name => $index->{INDNAME},
194 type => $index->{UNIQUERULE} eq 'U' ?
196 ) || die $table->error;
201 $trigsth->execute($table_info->{TABNAME});
202 my $trigs = $trigsth->fetchall_hashref("TRIGNAME");
203 print Dumper($trigs);
206 foreach my $t (values %$trigs)
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':
215 database_event => $t->{TRIGEVENT} eq 'I' ? 'insert'
216 : $t->{TRIGEVENT} eq 'D' ? 'delete'
218 action => $t->{TEXT},
219 on_table => $t->{TABNAME}
220 ) || die $schema->error;
222 # $trig->extra( reference => $def->{'reference'},
223 # condition => $def->{'condition'},
224 # granularity => $def->{'granularity'} );
235 # -------------------------------------------------------------------
236 # Time is a waste of money.
238 # -------------------------------------------------------------------
244 Jess Robinson <lt>castaway@desert-island.m.isar.de<gt>.
248 SQL::Translator, DBD::DB2.