Commit | Line | Data |
4c41d371 |
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 | |
ea93df61 |
13 | Uses DBI methods to determine schema structure. DBI, of course, |
4c41d371 |
14 | delegates to DBD::DB2. |
15 | |
16 | =cut |
17 | |
18 | use strict; |
f27f9229 |
19 | use warnings; |
4c41d371 |
20 | use DBI; |
21 | use Data::Dumper; |
173392cd |
22 | use SQL::Translator::Parser::DB2; |
4c41d371 |
23 | use SQL::Translator::Schema::Constants; |
24 | |
0c04c5a2 |
25 | our ($DEBUG, $VERSION, @EXPORT_OK ); |
11ad2df9 |
26 | # $VERSION = '1.59'; |
4c41d371 |
27 | $DEBUG = 0 unless defined $DEBUG; |
28 | |
4c41d371 |
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 | |
173392cd |
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({})}; |
4c41d371 |
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 = ? |
173392cd |
70 | ORDER BY COLNO |
4c41d371 |
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); |
ea93df61 |
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 |
4c41d371 |
100 | i.INDEXTYPE <> 'P' AND |
101 | i.TABNAME = ? |
102 | SQL |
103 | |
173392cd |
104 | my $trigsth = $dbh->prepare(<<SQL); |
105 | SELECT t.TRIGSCHEMA, |
106 | t.TRIGNAME, |
ea93df61 |
107 | t.TABSCHEMA, |
173392cd |
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 | |
4c41d371 |
120 | foreach my $table_info (@tables) { |
121 | next |
173392cd |
122 | unless (defined($table_info->{TYPE})); |
4c41d371 |
123 | |
124 | # Why are we not getting system tables, maybe a parameter should decide? |
125 | |
173392cd |
126 | if ($table_info->{TYPE} eq 'T'&& |
127 | $table_info->{TABSCHEMA} !~ /^SYS/) { |
4c41d371 |
128 | print Dumper($table_info) if($DEBUG); |
173392cd |
129 | print $table_info->{TABNAME} if($DEBUG); |
4c41d371 |
130 | my $table = $schema->add_table( |
173392cd |
131 | name => $table_info->{TABNAME}, |
132 | type => 'TABLE', |
4c41d371 |
133 | ) || die $schema->error; |
173392cd |
134 | $table->options("TABLESPACE", $table_info->{TBSPACE}); |
4c41d371 |
135 | |
173392cd |
136 | $colsth->execute($table_info->{TABNAME}); |
4c41d371 |
137 | my $cols = $colsth->fetchall_hashref("COLNAME"); |
ea93df61 |
138 | |
4c41d371 |
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 | |
ea93df61 |
150 | |
4c41d371 |
151 | $f->is_nullable($c->{NULLS} eq 'Y'); |
152 | } |
153 | |
173392cd |
154 | $consth->execute($table_info->{TABNAME}); |
4c41d371 |
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]}; |
ea93df61 |
160 | |
4c41d371 |
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 | |
ea93df61 |
170 | |
4c41d371 |
171 | $con->deferrable($c->{CHECKEXISTINGDATA} eq 'D'); |
ea93df61 |
172 | |
173392cd |
173 | $indsth->execute($table_info->{TABNAME}); |
4c41d371 |
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); |
173392cd |
181 | $indsth->execute($table_info->{TABNAME}); |
4c41d371 |
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; |
ea93df61 |
198 | |
199 | |
4c41d371 |
200 | } |
173392cd |
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) |
ea93df61 |
208 | { |
173392cd |
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' |
ea93df61 |
217 | : $t->{TRIGEVENT} eq 'D' ? 'delete' |
173392cd |
218 | : 'update', |
219 | action => $t->{TEXT}, |
ea93df61 |
220 | on_table => $t->{TABNAME} |
173392cd |
221 | ) || die $schema->error; |
ea93df61 |
222 | |
173392cd |
223 | # $trig->extra( reference => $def->{'reference'}, |
224 | # condition => $def->{'condition'}, |
225 | # granularity => $def->{'granularity'} ); |
226 | } |
227 | |
4c41d371 |
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 |