Commit | Line | Data |
996be9ee |
1 | package DBIx::Class::Schema::Loader::DBI::DB2; |
2 | |
3 | use strict; |
4 | use warnings; |
41968729 |
5 | use base qw/ |
6 | DBIx::Class::Schema::Loader::DBI::Component::QuotedDefault |
7 | DBIx::Class::Schema::Loader::DBI |
8 | /; |
942bd5e0 |
9 | use mro 'c3'; |
996be9ee |
10 | |
c4a69b87 |
11 | use List::MoreUtils 'any'; |
12 | use namespace::clean; |
13 | |
14 | use DBIx::Class::Schema::Loader::Table (); |
15 | |
22f91663 |
16 | our $VERSION = '0.07019'; |
32f784fc |
17 | |
996be9ee |
18 | =head1 NAME |
19 | |
20 | DBIx::Class::Schema::Loader::DBI::DB2 - DBIx::Class::Schema::Loader::DBI DB2 Implementation. |
21 | |
996be9ee |
22 | =head1 DESCRIPTION |
23 | |
c4a69b87 |
24 | See L<DBIx::Class::Schema::Loader> and L<DBIx::Class::Schema::Loader::Base>. |
996be9ee |
25 | |
26 | =cut |
27 | |
c4a69b87 |
28 | sub _system_schemas { |
29 | my $self = shift; |
30 | |
31 | return ($self->next::method(@_), qw/ |
32 | SYSCAT SYSIBM SYSIBMADM SYSPUBLIC SYSSTAT SYSTOOLS |
33 | /); |
34 | } |
35 | |
7a930e63 |
36 | sub _setup { |
37 | my $self = shift; |
38 | |
39 | $self->next::method(@_); |
40 | |
c4a69b87 |
41 | my $ns = $self->name_sep; |
42 | |
43 | $self->db_schema([ $self->dbh->selectrow_array(<<"EOF", {}) ]) unless $self->db_schema; |
44 | SELECT CURRENT_SCHEMA FROM sysibm${ns}sysdummy1 |
45 | EOF |
bc1cb85e |
46 | |
47 | if (not defined $self->preserve_case) { |
48 | $self->preserve_case(0); |
49 | } |
b511f36e |
50 | elsif ($self->preserve_case) { |
51 | $self->schema->storage->sql_maker->quote_char('"'); |
c4a69b87 |
52 | $self->schema->storage->sql_maker->name_sep($ns); |
b511f36e |
53 | } |
7a930e63 |
54 | } |
55 | |
996be9ee |
56 | sub _table_uniq_info { |
57 | my ($self, $table) = @_; |
58 | |
59 | my @uniqs; |
60 | |
c4a69b87 |
61 | my $sth = $self->{_cache}->{db2_uniq} ||= $self->dbh->prepare(<<'EOF'); |
62 | SELECT kcu.colname, kcu.constname, kcu.colseq |
63 | FROM syscat.tabconst as tc |
64 | JOIN syscat.keycoluse as kcu |
65 | ON tc.constname = kcu.constname |
66 | AND tc.tabschema = kcu.tabschema |
67 | AND tc.tabname = kcu.tabname |
68 | WHERE tc.tabschema = ? and tc.tabname = ? and tc.type = 'U' |
69 | EOF |
5223f24a |
70 | |
c4a69b87 |
71 | $sth->execute($table->schema, $table->name); |
996be9ee |
72 | |
73 | my %keydata; |
74 | while(my $row = $sth->fetchrow_arrayref) { |
75 | my ($col, $constname, $seq) = @$row; |
b511f36e |
76 | push(@{$keydata{$constname}}, [ $seq, $self->_lc($col) ]); |
996be9ee |
77 | } |
78 | foreach my $keyname (keys %keydata) { |
79 | my @ordered_cols = map { $_->[1] } sort { $a->[0] <=> $b->[0] } |
80 | @{$keydata{$keyname}}; |
81 | push(@uniqs, [ $keyname => \@ordered_cols ]); |
82 | } |
4421d6a3 |
83 | |
996be9ee |
84 | $sth->finish; |
85 | |
86 | return \@uniqs; |
87 | } |
88 | |
a168c1c4 |
89 | sub _table_fk_info { |
90 | my ($self, $table) = @_; |
91 | |
c4a69b87 |
92 | my $sth = $self->{_cache}->{db2_fk} ||= $self->dbh->prepare(<<'EOF'); |
93 | SELECT tc.constname, sr.reftabschema, sr.reftabname, |
94 | kcu.colname, rkcu.colname, kcu.colseq |
95 | FROM syscat.tabconst tc |
96 | JOIN syscat.keycoluse kcu |
97 | ON tc.constname = kcu.constname |
98 | AND tc.tabschema = kcu.tabschema |
99 | AND tc.tabname = kcu.tabname |
100 | JOIN syscat.references sr |
101 | ON tc.constname = sr.constname |
102 | AND tc.tabschema = sr.tabschema |
103 | AND tc.tabname = sr.tabname |
104 | JOIN syscat.keycoluse rkcu |
105 | ON sr.refkeyname = rkcu.constname |
106 | AND kcu.colseq = rkcu.colseq |
107 | WHERE tc.tabschema = ? |
108 | AND tc.tabname = ? |
109 | AND tc.type = 'F'; |
110 | EOF |
111 | $sth->execute($table->schema, $table->name); |
112 | |
113 | my %rels; |
114 | |
115 | COLS: while (my @row = $sth->fetchrow_array) { |
116 | my ($fk, $remote_schema, $remote_table, $local_col, $remote_col, |
117 | $colseq) = @row; |
118 | |
119 | if (not exists $rels{$fk}) { |
120 | if ($self->db_schema && $self->db_schema->[0] ne '%' |
121 | && (not any { $_ eq $remote_schema } @{ $self->db_schema })) { |
122 | |
123 | next COLS; |
124 | } |
a168c1c4 |
125 | |
c4a69b87 |
126 | $rels{$fk}{remote_table} = DBIx::Class::Schema::Loader::Table->new( |
127 | loader => $self, |
128 | name => $remote_table, |
129 | schema => $remote_schema, |
130 | ); |
131 | } |
132 | |
133 | $rels{$fk}{local_columns}[$colseq-1] = $self->_lc($local_col); |
134 | $rels{$fk}{remote_columns}[$colseq-1] = $self->_lc($remote_col); |
a168c1c4 |
135 | } |
136 | |
c4a69b87 |
137 | return [ values %rels ]; |
138 | } |
139 | |
140 | |
141 | # DBD::DB2 doesn't follow the DBI API for ->tables |
142 | sub _dbh_tables { |
143 | my ($self, $schema) = @_; |
144 | |
145 | return $self->dbh->tables($schema ? { TABLE_SCHEM => $schema } : undef); |
a168c1c4 |
146 | } |
147 | |
148 | sub _columns_info_for { |
8a64178e |
149 | my $self = shift; |
150 | my ($table) = @_; |
a168c1c4 |
151 | |
c4a69b87 |
152 | my $result = $self->next::method(@_); |
8a64178e |
153 | |
154 | while (my ($col, $info) = each %$result) { |
155 | # check for identities |
c4a69b87 |
156 | my $sth = $self->dbh->prepare_cached( |
8a64178e |
157 | q{ |
158 | SELECT COUNT(*) |
159 | FROM syscat.columns |
160 | WHERE tabschema = ? AND tabname = ? AND colname = ? |
161 | AND identity = 'Y' AND generated != '' |
162 | }, |
163 | {}, 1); |
c4a69b87 |
164 | $sth->execute($table->schema, $table->name, $self->_uc($col)); |
8a64178e |
165 | if ($sth->fetchrow_array) { |
166 | $info->{is_auto_increment} = 1; |
167 | } |
168 | |
7640ef4b |
169 | my $data_type = $info->{data_type}; |
170 | |
171 | if ($data_type !~ /^(?:(?:var)?(?:char|graphic)|decimal)\z/i) { |
8a64178e |
172 | delete $info->{size}; |
7640ef4b |
173 | } |
174 | |
175 | if ($data_type eq 'double') { |
176 | $info->{data_type} = 'double precision'; |
177 | } |
178 | elsif ($data_type eq 'decimal') { |
179 | no warnings 'uninitialized'; |
180 | |
181 | $info->{data_type} = 'numeric'; |
182 | |
183 | my @size = @{ $info->{size} || [] }; |
184 | |
185 | if ($size[0] == 5 && $size[1] == 0) { |
186 | delete $info->{size}; |
187 | } |
188 | } |
189 | elsif ($data_type =~ /^(?:((?:var)?char) \(\) for bit data|(long varchar) for bit data)\z/i) { |
190 | my $base_type = lc($1 || $2); |
191 | |
192 | (my $original_type = $data_type) =~ s/[()]+ //; |
193 | |
194 | $info->{original}{data_type} = $original_type; |
195 | |
196 | if ($base_type eq 'long varchar') { |
197 | $info->{data_type} = 'blob'; |
198 | } |
199 | else { |
200 | if ($base_type eq 'char') { |
201 | $info->{data_type} = 'binary'; |
202 | } |
203 | elsif ($base_type eq 'varchar') { |
204 | $info->{data_type} = 'varbinary'; |
205 | } |
206 | |
c4a69b87 |
207 | my ($size) = $self->dbh->selectrow_array(<<'EOF', {}, $table->schema, $table->name, $self->_uc($col)); |
7640ef4b |
208 | SELECT length |
209 | FROM syscat.columns |
210 | WHERE tabschema = ? AND tabname = ? AND colname = ? |
211 | EOF |
212 | |
213 | $info->{size} = $size if $size; |
214 | } |
215 | } |
216 | |
217 | if ((eval { lc ${ $info->{default_value} } }||'') =~ /^current (date|time(?:stamp)?)\z/i) { |
218 | my $type = lc($1); |
219 | |
220 | ${ $info->{default_value} } = 'current_timestamp'; |
701cd3e3 |
221 | |
7640ef4b |
222 | my $orig_deflt = "current $type"; |
701cd3e3 |
223 | $info->{original}{default_value} = \$orig_deflt; |
8a64178e |
224 | } |
772cfe65 |
225 | } |
226 | |
8a64178e |
227 | return $result; |
772cfe65 |
228 | } |
229 | |
996be9ee |
230 | =head1 SEE ALSO |
231 | |
232 | L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>, |
233 | L<DBIx::Class::Schema::Loader::DBI> |
234 | |
be80bba7 |
235 | =head1 AUTHOR |
236 | |
9cc8e7e1 |
237 | See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>. |
be80bba7 |
238 | |
239 | =head1 LICENSE |
240 | |
241 | This library is free software; you can redistribute it and/or modify it under |
242 | the same terms as Perl itself. |
243 | |
996be9ee |
244 | =cut |
245 | |
246 | 1; |
8a64178e |
247 | # vim:et sts=4 sw=4 tw=0: |