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::Schema::Constants;
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;
27 # -------------------------------------------------------------------
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 $sth = $dbh->table_info();
46 @tables = @{$sth->fetchall_arrayref({})};
48 my $colsth = $dbh->prepare(<<SQL);
58 WHERE c.TABSCHEMA NOT LIKE 'SYS%' AND
62 my $consth = $dbh->prepare(<<SQL);
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
77 my $indsth = $dbh->prepare(<<SQL);
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
93 foreach my $table_info (@tables) {
95 unless (defined($table_info->{TABLE_TYPE}));
97 # Why are we not getting system tables, maybe a parameter should decide?
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;
108 $colsth->execute($table_info->{TABLE_NAME});
109 my $cols = $colsth->fetchall_hashref("COLNAME");
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;
123 $f->is_nullable($c->{NULLS} eq 'Y');
126 $consth->execute($table_info->{TABLE_NAME});
127 my $cons = $consth->fetchall_hashref("COLNAME");
130 my @fields = map { $_->{COLNAME} } (values %{$cons});
131 my $c = $cons->{$fields[0]};
133 print $c->{CONSTNAME} if($DEBUG);
134 my $con = $table->add_constraint(
135 name => $c->{CONSTNAME},
137 type => $c->{TYPE} eq 'P' ?
138 PRIMARY_KEY : $c->{TYPE} eq 'F' ?
140 ) || die $table->error;
143 $con->deferrable($c->{CHECKEXISTINGDATA} eq 'D');
145 $indsth->execute($table_info->{TABLE_NAME});
146 my $inds = $indsth->fetchall_hashref("INDNAME");
147 print Dumper($inds) if($DEBUG);
150 foreach my $ind (keys %$inds)
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');
157 print Dumper($indcols) if($DEBUG);
159 my @fields = map { $_->{INDNAME} eq $ind ? $_->{COLNAME} : () }
160 (values %{$indcols});
162 my $index = $indcols->{$fields[0]};
164 my $inew = $table->add_index(
165 name => $index->{INDNAME},
167 type => $index->{UNIQUERULE} eq 'U' ?
169 ) || die $table->error;
181 # -------------------------------------------------------------------
182 # Time is a waste of money.
184 # -------------------------------------------------------------------
190 Jess Robinson <lt>castaway@desert-island.m.isar.de<gt>.
194 SQL::Translator, DBD::DB2.