1 package DBIx::Class::Schema::Loader::DBI::Informix;
6 use base qw/DBIx::Class::Schema::Loader::DBI/;
7 use namespace::autoclean;
8 use Carp::Clan qw/^DBIx::Class/;
9 use Scalar::Util 'looks_like_number';
11 our $VERSION = '0.07001';
15 DBIx::Class::Schema::Loader::DBI::Informix - DBIx::Class::Schema::Loader::DBI
16 Informix Implementation.
20 See L<DBIx::Class::Schema::Loader> and L<DBIx::Class::Schema::Loader::Base>.
27 $self->next::method(@_);
29 if (not defined $self->preserve_case) {
30 $self->preserve_case(0);
32 elsif ($self->preserve_case) {
33 $self->schema->storage->sql_maker->quote_char('"');
34 $self->schema->storage->sql_maker->name_sep('.');
39 my ($self, $opts) = @_;
41 my $dbh = $self->schema->storage->dbh;
42 my $sth = $dbh->prepare(<<'EOF');
43 select tabname from systables t
44 where t.owner <> 'informix' and t.owner <> '' and t.tabname <> ' VERSION'
48 my @tables = map @$_, @{ $sth->fetchall_arrayref };
50 return $self->_filter_tables(\@tables, $opts);
53 sub _constraints_for {
54 my ($self, $table, $type) = @_;
56 my $dbh = $self->schema->storage->dbh;
57 local $dbh->{FetchHashKeyName} = 'NAME_lc';
59 my $sth = $dbh->prepare(<<'EOF');
60 select c.constrname, i.*
62 join systables t on t.tabid = c.tabid
63 join sysindexes i on c.idxname = i.idxname
64 where t.tabname = ? and c.constrtype = ?
66 $sth->execute($table, $type);
67 my $indexes = $sth->fetchall_hashref('constrname');
70 my $cols = $self->_colnames_by_colno($table);
73 while (my ($constr_name, $idx_def) = each %$indexes) {
74 $constraints->{$constr_name} = $self->_idx_colnames($idx_def, $cols);
81 my ($self, $idx_info, $table_cols_by_colno) = @_;
83 return [ map $self->_lc($table_cols_by_colno->{$_}), grep $_, map $idx_info->{$_}, map "part$_", (1..16) ];
86 sub _colnames_by_colno {
87 my ($self, $table) = @_;
89 my $dbh = $self->schema->storage->dbh;
90 local $dbh->{FetchHashKeyName} = 'NAME_lc';
92 my $sth = $dbh->prepare(<<'EOF');
93 select c.colname, c.colno
95 join systables t on c.tabid = t.tabid
98 $sth->execute($table);
99 my $cols = $sth->fetchall_hashref('colno');
100 $cols = { map +($_, $cols->{$_}{colname}), keys %$cols };
106 my ($self, $table) = @_;
108 my $pk = (values %{ $self->_constraints_for($table, 'P') || {} })[0];
113 sub _table_uniq_info {
114 my ($self, $table) = @_;
116 my $constraints = $self->_constraints_for($table, 'U');
118 my @uniqs = map { [ $_ => $constraints->{$_} ] } keys %$constraints;
123 my ($self, $table) = @_;
125 my $local_columns = $self->_constraints_for($table, 'R');
127 my $dbh = $self->schema->storage->dbh;
128 local $dbh->{FetchHashKeyName} = 'NAME_lc';
130 my $sth = $dbh->prepare(<<'EOF');
131 select c.constrname local_constraint, rt.tabname remote_table, rc.constrname remote_constraint, ri.*
132 from sysconstraints c
133 join systables t on c.tabid = t.tabid
134 join sysreferences r on c.constrid = r.constrid
135 join sysconstraints rc on rc.constrid = r.primary
136 join systables rt on r.ptabid = rt.tabid
137 join sysindexes ri on rc.idxname = ri.idxname
138 where t.tabname = ? and c.constrtype = 'R'
140 $sth->execute($table);
141 my $remotes = $sth->fetchall_hashref('local_constraint');
146 while (my ($local_constraint, $remote_info) = each %$remotes) {
148 local_columns => $local_columns->{$local_constraint},
149 remote_columns => $self->_idx_colnames($remote_info, $self->_colnames_by_colno($remote_info->{remote_table})),
150 remote_table => $remote_info->{remote_table},
157 # This is directly from http://www.ibm.com/developerworks/data/zones/informix/library/techarticle/0305parker/0305parker.html
158 # it doesn't work at all
159 sub _informix_datetime_precision {
160 my @date_type = qw/DUMMY year month day hour minute second fraction(1) fraction(2) fraction(3) fraction(4) fraction(5)/;
161 my @start_end = ( [], [1,5],[5,7],[7,9],[9,11],[11,13],[13,15],[15,16], [16,17], [17,18], [18,19], [19,20] );
163 my ($self, $collength) = @_;
165 my $i = ($collength % 16) + 1;
166 my $j = int(($collength % 256) / 16) + 1;
167 my $k = int($collength / 256);
169 my $len = $start_end[$i][1] - $start_end[$j][0];
172 if ($len == 0 || $j > 11) {
173 return $date_type[$j] . ' to ' . $date_type[$i];
176 $k = $start_end[$j][1] - $start_end[$j][0];
179 return $date_type[$j] . "($k) to " . $date_type[$i];
182 sub _columns_info_for {
186 my $result = $self->next::method(@_);
188 my $dbh = $self->schema->storage->dbh;
189 local $dbh->{FetchHashKeyName} = 'NAME_lc';
191 my $sth = $dbh->prepare(<<'EOF');
192 select c.colname, c.coltype, c.collength, c.colmin, d.type deflt_type, d.default deflt
194 join systables t on c.tabid = t.tabid
195 left join sysdefaults d on t.tabid = d.tabid and c.colno = d.colno
198 $sth->execute($table);
199 my $cols = $sth->fetchall_hashref('colname');
202 while (my ($col, $info) = each %$cols) {
203 $col = $self->_lc($col);
205 my $type = $info->{coltype} % 256;
207 if ($type == 6) { # SERIAL
208 $result->{$col}{is_auto_increment} = 1;
211 my $data_type = $result->{$col}{data_type};
213 if (looks_like_number $data_type) {
215 $result->{$col}{data_type} = 'date';
217 elsif ($type == 10) {
218 $result->{$col}{data_type} = 'datetime year to fraction(5)';
219 # this doesn't work yet
220 # $result->{$col}{data_type} = 'datetime ' . $self->_informix_datetime_precision($info->{collength});
222 elsif ($type == 17 || $type == 52) {
223 $result->{$col}{data_type} = 'bigint';
225 elsif ($type == 40) {
226 $result->{$col}{data_type} = 'lvarchar';
227 $result->{$col}{size} = $info->{collength};
229 elsif ($type == 12) {
230 $result->{$col}{data_type} = 'text';
232 elsif ($type == 11) {
233 $result->{$col}{data_type} = 'bytea';
234 $result->{$col}{original}{data_type} = 'byte';
236 elsif ($type == 41) {
237 # XXX no way to distinguish opaque types boolean, blob and clob
238 $result->{$col}{data_type} = 'blob';
240 elsif ($type == 21) {
241 $result->{$col}{data_type} = 'list';
243 elsif ($type == 20) {
244 $result->{$col}{data_type} = 'multiset';
246 elsif ($type == 19) {
247 $result->{$col}{data_type} = 'set';
252 $result->{$col}{data_type} = 'nchar';
254 elsif ($type == 16) {
255 $result->{$col}{data_type} = 'nvarchar';
258 elsif ($info->{coltype} == 2061) {
259 $result->{$col}{data_type} = 'idssecuritylabel';
262 # XXX colmin doesn't work for min size of varchar columns, it's NULL
263 # if (lc($data_type) eq 'varchar') {
264 # $result->{$col}{size}[1] = $info->{colmin};
267 my ($default_type, $default) = @{$info}{qw/deflt_type deflt/};
269 next unless $default_type;
271 if ($default_type eq 'C') {
272 my $current = 'current year to fraction(5)';
273 $result->{$col}{default_value} = \$current;
275 elsif ($default_type eq 'T') {
277 $result->{$col}{default_value} = \$today;
280 $default = (split ' ', $default, 2)[-1];
282 $default =~ s/\s+\z// if looks_like_number $default;
284 # remove trailing 0s in floating point defaults
285 # disabled, this is unsafe since it might be a varchar default
286 #$default =~ s/0+\z// if $default =~ /^\d+\.\d+\z/;
288 $result->{$col}{default_value} = $default;
292 # fix up data_types some more
293 while (my ($col, $info) = each %$result) {
294 my $data_type = $info->{data_type};
296 if ($data_type !~ /^(?:[nl]?(?:var)?char|decimal)\z/i) {
297 delete $info->{size};
300 if (lc($data_type) eq 'decimal') {
301 no warnings 'uninitialized';
303 $info->{data_type} = 'numeric';
305 my @size = @{ $info->{size} || [] };
307 if ($size[0] == 16 && $size[1] == -4) {
308 delete $info->{size};
310 elsif ($size[0] == 16 && $size[1] == 2) {
311 $info->{data_type} = 'money';
312 delete $info->{size};
315 elsif (lc($data_type) eq 'smallfloat') {
316 $info->{data_type} = 'real';
318 elsif (lc($data_type) eq 'float') {
319 $info->{data_type} = 'double precision';
321 elsif ($data_type =~ /^n?(?:var)?char\z/i) {
322 $info->{size} = $info->{size}[0];
331 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
332 L<DBIx::Class::Schema::Loader::DBI>
336 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
340 This library is free software; you can redistribute it and/or modify it under
341 the same terms as Perl itself.
346 # vim:et sw=4 sts=4 tw=0: