Commit | Line | Data |
996be9ee |
1 | package DBIx::Class::Schema::Loader::DBI::DB2; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use base 'DBIx::Class::Schema::Loader::DBI'; |
fa994d3c |
6 | use Carp::Clan qw/^DBIx::Class/; |
996be9ee |
7 | use Class::C3; |
8 | |
b1ad1a84 |
9 | our $VERSION = '0.04999_10'; |
32f784fc |
10 | |
996be9ee |
11 | =head1 NAME |
12 | |
13 | DBIx::Class::Schema::Loader::DBI::DB2 - DBIx::Class::Schema::Loader::DBI DB2 Implementation. |
14 | |
15 | =head1 SYNOPSIS |
16 | |
17 | package My::Schema; |
18 | use base qw/DBIx::Class::Schema::Loader/; |
19 | |
59cfa251 |
20 | __PACKAGE__->loader_options( db_schema => "MYSCHEMA" ); |
996be9ee |
21 | |
22 | 1; |
23 | |
24 | =head1 DESCRIPTION |
25 | |
26 | See L<DBIx::Class::Schema::Loader::Base>. |
27 | |
28 | =cut |
29 | |
7a930e63 |
30 | sub _setup { |
31 | my $self = shift; |
32 | |
33 | $self->next::method(@_); |
34 | |
35 | my $dbh = $self->schema->storage->dbh; |
36 | $self->{db_schema} ||= $dbh->selectrow_array('VALUES(CURRENT_USER)', {}); |
37 | } |
38 | |
996be9ee |
39 | sub _table_uniq_info { |
40 | my ($self, $table) = @_; |
41 | |
42 | my @uniqs; |
43 | |
44 | my $dbh = $self->schema->storage->dbh; |
45 | |
5223f24a |
46 | my $sth = $self->{_cache}->{db2_uniq} ||= $dbh->prepare( |
47 | q{SELECT kcu.COLNAME, kcu.CONSTNAME, kcu.COLSEQ |
48 | FROM SYSCAT.TABCONST as tc |
49 | JOIN SYSCAT.KEYCOLUSE as kcu ON tc.CONSTNAME = kcu.CONSTNAME |
50 | WHERE tc.TABSCHEMA = ? and tc.TABNAME = ? and tc.TYPE = 'U'} |
4421d6a3 |
51 | ) or die $DBI::errstr; |
5223f24a |
52 | |
a168c1c4 |
53 | $sth->execute($self->db_schema, uc $table) or die $DBI::errstr; |
996be9ee |
54 | |
55 | my %keydata; |
56 | while(my $row = $sth->fetchrow_arrayref) { |
57 | my ($col, $constname, $seq) = @$row; |
58 | push(@{$keydata{$constname}}, [ $seq, lc $col ]); |
59 | } |
60 | foreach my $keyname (keys %keydata) { |
61 | my @ordered_cols = map { $_->[1] } sort { $a->[0] <=> $b->[0] } |
62 | @{$keydata{$keyname}}; |
63 | push(@uniqs, [ $keyname => \@ordered_cols ]); |
64 | } |
4421d6a3 |
65 | |
996be9ee |
66 | $sth->finish; |
67 | |
68 | return \@uniqs; |
69 | } |
70 | |
072d5aae |
71 | # DBD::DB2 doesn't follow the DBI API for ->tables |
72 | sub _tables_list { |
a168c1c4 |
73 | my $self = shift; |
072d5aae |
74 | |
75 | my $dbh = $self->schema->storage->dbh; |
76 | my @tables = map { lc } $dbh->tables( |
77 | $self->db_schema ? { TABLE_SCHEM => $self->db_schema } : undef |
78 | ); |
79 | s/\Q$self->{_quoter}\E//g for @tables; |
80 | s/^.*\Q$self->{_namesep}\E// for @tables; |
81 | |
82 | return @tables; |
a168c1c4 |
83 | } |
84 | |
85 | sub _table_pk_info { |
86 | my ($self, $table) = @_; |
87 | return $self->next::method(uc $table); |
88 | } |
89 | |
90 | sub _table_fk_info { |
91 | my ($self, $table) = @_; |
92 | |
93 | my $rels = $self->next::method(uc $table); |
94 | |
95 | foreach my $rel (@$rels) { |
96 | $rel->{remote_table} = lc $rel->{remote_table}; |
97 | } |
98 | |
99 | return $rels; |
100 | } |
101 | |
102 | sub _columns_info_for { |
103 | my ($self, $table) = @_; |
104 | return $self->next::method(uc $table); |
105 | } |
106 | |
772cfe65 |
107 | sub _extra_column_info { |
108 | my ($self, $info) = @_; |
109 | my %extra_info; |
110 | |
111 | my ($table, $column) = @$info{qw/TABLE_NAME COLUMN_NAME/}; |
112 | |
113 | my $dbh = $self->schema->storage->dbh; |
114 | my $sth = $dbh->prepare_cached( |
115 | q{ |
116 | SELECT COUNT(*) |
117 | FROM syscat.columns |
118 | WHERE tabschema = ? AND tabname = ? AND colname = ? |
119 | AND identity = 'Y' AND generated != '' |
120 | }, |
121 | {}, 1); |
122 | $sth->execute($self->db_schema, $table, $column); |
123 | if ($sth->fetchrow_array) { |
124 | $extra_info{is_auto_increment} = 1; |
125 | } |
126 | |
127 | return \%extra_info; |
128 | } |
129 | |
996be9ee |
130 | =head1 SEE ALSO |
131 | |
132 | L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>, |
133 | L<DBIx::Class::Schema::Loader::DBI> |
134 | |
135 | =cut |
136 | |
137 | 1; |