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 | |
d372611d |
16 | our $VERSION = '0.07036'; |
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; |
075473b9 |
85 | |
996be9ee |
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, |
075473b9 |
94 | kcu.colname, rkcu.colname, kcu.colseq, |
95 | sr.deleterule, sr.updaterule |
c4a69b87 |
96 | FROM syscat.tabconst tc |
97 | JOIN syscat.keycoluse kcu |
98 | ON tc.constname = kcu.constname |
99 | AND tc.tabschema = kcu.tabschema |
100 | AND tc.tabname = kcu.tabname |
101 | JOIN syscat.references sr |
102 | ON tc.constname = sr.constname |
103 | AND tc.tabschema = sr.tabschema |
104 | AND tc.tabname = sr.tabname |
105 | JOIN syscat.keycoluse rkcu |
106 | ON sr.refkeyname = rkcu.constname |
107 | AND kcu.colseq = rkcu.colseq |
108 | WHERE tc.tabschema = ? |
109 | AND tc.tabname = ? |
110 | AND tc.type = 'F'; |
111 | EOF |
112 | $sth->execute($table->schema, $table->name); |
113 | |
114 | my %rels; |
115 | |
075473b9 |
116 | my %rules = ( |
117 | A => 'NO ACTION', |
118 | C => 'CASCADE', |
119 | N => 'SET NULL', |
120 | R => 'RESTRICT', |
121 | ); |
122 | |
c4a69b87 |
123 | COLS: while (my @row = $sth->fetchrow_array) { |
124 | my ($fk, $remote_schema, $remote_table, $local_col, $remote_col, |
075473b9 |
125 | $colseq, $delete_rule, $update_rule) = @row; |
c4a69b87 |
126 | |
127 | if (not exists $rels{$fk}) { |
128 | if ($self->db_schema && $self->db_schema->[0] ne '%' |
129 | && (not any { $_ eq $remote_schema } @{ $self->db_schema })) { |
130 | |
131 | next COLS; |
132 | } |
a168c1c4 |
133 | |
c4a69b87 |
134 | $rels{$fk}{remote_table} = DBIx::Class::Schema::Loader::Table->new( |
135 | loader => $self, |
136 | name => $remote_table, |
137 | schema => $remote_schema, |
138 | ); |
139 | } |
140 | |
141 | $rels{$fk}{local_columns}[$colseq-1] = $self->_lc($local_col); |
142 | $rels{$fk}{remote_columns}[$colseq-1] = $self->_lc($remote_col); |
075473b9 |
143 | |
144 | $rels{$fk}{attrs} ||= { |
145 | on_delete => $rules{$delete_rule}, |
146 | on_update => $rules{$update_rule}, |
147 | is_deferrable => 1, # DB2 has no deferrable constraints |
148 | }; |
a168c1c4 |
149 | } |
150 | |
c4a69b87 |
151 | return [ values %rels ]; |
152 | } |
153 | |
154 | |
155 | # DBD::DB2 doesn't follow the DBI API for ->tables |
156 | sub _dbh_tables { |
157 | my ($self, $schema) = @_; |
158 | |
159 | return $self->dbh->tables($schema ? { TABLE_SCHEM => $schema } : undef); |
a168c1c4 |
160 | } |
161 | |
162 | sub _columns_info_for { |
8a64178e |
163 | my $self = shift; |
164 | my ($table) = @_; |
a168c1c4 |
165 | |
c4a69b87 |
166 | my $result = $self->next::method(@_); |
8a64178e |
167 | |
168 | while (my ($col, $info) = each %$result) { |
169 | # check for identities |
c4a69b87 |
170 | my $sth = $self->dbh->prepare_cached( |
8a64178e |
171 | q{ |
172 | SELECT COUNT(*) |
173 | FROM syscat.columns |
174 | WHERE tabschema = ? AND tabname = ? AND colname = ? |
175 | AND identity = 'Y' AND generated != '' |
176 | }, |
177 | {}, 1); |
c4a69b87 |
178 | $sth->execute($table->schema, $table->name, $self->_uc($col)); |
8a64178e |
179 | if ($sth->fetchrow_array) { |
180 | $info->{is_auto_increment} = 1; |
181 | } |
182 | |
7640ef4b |
183 | my $data_type = $info->{data_type}; |
184 | |
185 | if ($data_type !~ /^(?:(?:var)?(?:char|graphic)|decimal)\z/i) { |
8a64178e |
186 | delete $info->{size}; |
7640ef4b |
187 | } |
188 | |
189 | if ($data_type eq 'double') { |
190 | $info->{data_type} = 'double precision'; |
191 | } |
192 | elsif ($data_type eq 'decimal') { |
193 | no warnings 'uninitialized'; |
194 | |
195 | $info->{data_type} = 'numeric'; |
196 | |
197 | my @size = @{ $info->{size} || [] }; |
198 | |
199 | if ($size[0] == 5 && $size[1] == 0) { |
200 | delete $info->{size}; |
201 | } |
202 | } |
203 | elsif ($data_type =~ /^(?:((?:var)?char) \(\) for bit data|(long varchar) for bit data)\z/i) { |
204 | my $base_type = lc($1 || $2); |
205 | |
206 | (my $original_type = $data_type) =~ s/[()]+ //; |
207 | |
208 | $info->{original}{data_type} = $original_type; |
209 | |
210 | if ($base_type eq 'long varchar') { |
211 | $info->{data_type} = 'blob'; |
212 | } |
213 | else { |
214 | if ($base_type eq 'char') { |
215 | $info->{data_type} = 'binary'; |
216 | } |
217 | elsif ($base_type eq 'varchar') { |
218 | $info->{data_type} = 'varbinary'; |
219 | } |
220 | |
c4a69b87 |
221 | my ($size) = $self->dbh->selectrow_array(<<'EOF', {}, $table->schema, $table->name, $self->_uc($col)); |
7640ef4b |
222 | SELECT length |
223 | FROM syscat.columns |
224 | WHERE tabschema = ? AND tabname = ? AND colname = ? |
225 | EOF |
226 | |
227 | $info->{size} = $size if $size; |
228 | } |
229 | } |
230 | |
231 | if ((eval { lc ${ $info->{default_value} } }||'') =~ /^current (date|time(?:stamp)?)\z/i) { |
232 | my $type = lc($1); |
233 | |
234 | ${ $info->{default_value} } = 'current_timestamp'; |
701cd3e3 |
235 | |
7640ef4b |
236 | my $orig_deflt = "current $type"; |
701cd3e3 |
237 | $info->{original}{default_value} = \$orig_deflt; |
8a64178e |
238 | } |
772cfe65 |
239 | } |
240 | |
8a64178e |
241 | return $result; |
772cfe65 |
242 | } |
243 | |
996be9ee |
244 | =head1 SEE ALSO |
245 | |
246 | L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>, |
247 | L<DBIx::Class::Schema::Loader::DBI> |
248 | |
be80bba7 |
249 | =head1 AUTHOR |
250 | |
9cc8e7e1 |
251 | See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>. |
be80bba7 |
252 | |
253 | =head1 LICENSE |
254 | |
255 | This library is free software; you can redistribute it and/or modify it under |
256 | the same terms as Perl itself. |
257 | |
996be9ee |
258 | =cut |
259 | |
260 | 1; |
8a64178e |
261 | # vim:et sts=4 sw=4 tw=0: |