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 | |
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::Schema::Constants; |
22 | |
23 | use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; |
24 | $VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/; |
25 | $DEBUG = 0 unless defined $DEBUG; |
26 | |
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 | $sth = $dbh->table_info(); |
45 | |
46 | @tables = @{$sth->fetchall_arrayref({})}; |
47 | |
48 | my $colsth = $dbh->prepare(<<SQL); |
49 | SELECT c.TABSCHEMA, |
50 | c.TABNAME, |
51 | c.COLNAME, |
52 | c.TYPENAME, |
53 | c.LENGTH, |
54 | c.DEFAULT, |
55 | c.NULLS, |
56 | c.COLNO |
57 | FROM SYSCAT.COLUMNS c |
58 | WHERE c.TABSCHEMA NOT LIKE 'SYS%' AND |
59 | c.TABNAME = ? |
60 | SQL |
61 | |
62 | my $consth = $dbh->prepare(<<SQL); |
63 | SELECT tc.TABSCHEMA, |
64 | tc.TABNAME, |
65 | kc.CONSTNAME, |
66 | kc.COLNAME, |
67 | tc.TYPE, |
68 | tc.CHECKEXISTINGDATA |
69 | FROM SYSCAT.TABCONST tc |
70 | JOIN SYSCAT.KEYCOLUSE kc ON tc.CONSTNAME = kc.CONSTNAME AND |
71 | tc.TABSCHEMA = kc.TABSCHEMA AND |
72 | tc.TABNAME = kc.TABNAME |
73 | WHERE tc.TABSCHEMA NOT LIKE 'SYS%' AND |
74 | tc.TABNAME = ? |
75 | SQL |
76 | |
77 | my $indsth = $dbh->prepare(<<SQL); |
78 | SELECT i.INDSCHEMA, |
79 | i.INDNAME, |
80 | i.TABSCHEMA, |
81 | i.TABNAME, |
82 | i.UNIQUERULE, |
83 | i.INDEXTYPE, |
84 | ic.COLNAME |
85 | FROM SYSCAT.INDEXES i |
86 | JOIN SYSCAT.INDEXCOLUSE ic ON i.INDSCHEMA = ic.INDSCHEMA AND |
87 | i.INDNAME = ic.INDNAME |
88 | WHERE i.TABSCHEMA NOT LIKE 'SYS%' AND |
89 | i.INDEXTYPE <> 'P' AND |
90 | i.TABNAME = ? |
91 | SQL |
92 | |
93 | foreach my $table_info (@tables) { |
94 | next |
95 | unless (defined($table_info->{TABLE_TYPE})); |
96 | |
97 | # Why are we not getting system tables, maybe a parameter should decide? |
98 | |
99 | if ($table_info->{TABLE_TYPE} eq 'TABLE'&& |
100 | $table_info->{TABLE_SCHEM} !~ /^SYS/) { |
101 | print Dumper($table_info) if($DEBUG); |
102 | print $table_info->{TABLE_NAME} if($DEBUG); |
103 | my $table = $schema->add_table( |
104 | name => $table_info->{TABLE_NAME}, |
105 | type => $table_info->{TABLE_TYPE}, |
106 | ) || die $schema->error; |
107 | |
108 | $colsth->execute($table_info->{TABLE_NAME}); |
109 | my $cols = $colsth->fetchall_hashref("COLNAME"); |
110 | |
111 | foreach my $c (values %{$cols}) { |
112 | print Dumper($c) if $DEBUG; |
113 | print $c->{COLNAME} if($DEBUG); |
114 | my $f = $table->add_field( |
115 | name => $c->{COLNAME}, |
116 | default_value => $c->{DEFAULT}, |
117 | data_type => $c->{TYPENAME}, |
118 | order => $c->{COLNO}, |
119 | size => $c->{LENGTH}, |
120 | ) || die $table->error; |
121 | |
122 | |
123 | $f->is_nullable($c->{NULLS} eq 'Y'); |
124 | } |
125 | |
126 | $consth->execute($table_info->{TABLE_NAME}); |
127 | my $cons = $consth->fetchall_hashref("COLNAME"); |
128 | next if(!%$cons); |
129 | |
130 | my @fields = map { $_->{COLNAME} } (values %{$cons}); |
131 | my $c = $cons->{$fields[0]}; |
132 | |
133 | print $c->{CONSTNAME} if($DEBUG); |
134 | my $con = $table->add_constraint( |
135 | name => $c->{CONSTNAME}, |
136 | fields => \@fields, |
137 | type => $c->{TYPE} eq 'P' ? |
138 | PRIMARY_KEY : $c->{TYPE} eq 'F' ? |
139 | FOREIGN_KEY : UNIQUE |
140 | ) || die $table->error; |
141 | |
142 | |
143 | $con->deferrable($c->{CHECKEXISTINGDATA} eq 'D'); |
144 | |
145 | $indsth->execute($table_info->{TABLE_NAME}); |
146 | my $inds = $indsth->fetchall_hashref("INDNAME"); |
147 | print Dumper($inds) if($DEBUG); |
148 | next if(!%$inds); |
149 | |
150 | foreach my $ind (keys %$inds) |
151 | { |
152 | print $ind if($DEBUG); |
153 | $indsth->execute($table_info->{TABLE_NAME}); |
154 | my $indcols = $indsth->fetchall_hashref("COLNAME"); |
155 | next if($inds->{$ind}{UNIQUERULE} eq 'P'); |
156 | |
157 | print Dumper($indcols) if($DEBUG); |
158 | |
159 | my @fields = map { $_->{INDNAME} eq $ind ? $_->{COLNAME} : () } |
160 | (values %{$indcols}); |
161 | |
162 | my $index = $indcols->{$fields[0]}; |
163 | |
164 | my $inew = $table->add_index( |
165 | name => $index->{INDNAME}, |
166 | fields => \@fields, |
167 | type => $index->{UNIQUERULE} eq 'U' ? |
168 | UNIQUE : NORMAL |
169 | ) || die $table->error; |
170 | |
171 | |
172 | } |
173 | } |
174 | } |
175 | |
176 | return 1; |
177 | } |
178 | |
179 | 1; |
180 | |
181 | # ------------------------------------------------------------------- |
182 | # Time is a waste of money. |
183 | # Oscar Wilde |
184 | # ------------------------------------------------------------------- |
185 | |
186 | =pod |
187 | |
188 | =head1 AUTHOR |
189 | |
190 | Jess Robinson <lt>castaway@desert-island.m.isar.de<gt>. |
191 | |
192 | =head1 SEE ALSO |
193 | |
194 | SQL::Translator, DBD::DB2. |
195 | |
196 | =cut |