1 package DBIx::Class::Schema::Loader::DBI::DB2;
5 use base 'DBIx::Class::Schema::Loader::DBI';
6 use Carp::Clan qw/^DBIx::Class/;
9 our $VERSION = '0.04999_14';
13 DBIx::Class::Schema::Loader::DBI::DB2 - DBIx::Class::Schema::Loader::DBI DB2 Implementation.
18 use base qw/DBIx::Class::Schema::Loader/;
20 __PACKAGE__->loader_options( db_schema => "MYSCHEMA" );
26 See L<DBIx::Class::Schema::Loader::Base>.
33 $self->next::method(@_);
35 my $dbh = $self->schema->storage->dbh;
36 $self->{db_schema} ||= $dbh->selectrow_array('VALUES(CURRENT_USER)', {});
39 sub _table_uniq_info {
40 my ($self, $table) = @_;
44 my $dbh = $self->schema->storage->dbh;
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'}
51 ) or die $DBI::errstr;
53 $sth->execute($self->db_schema, uc $table) or die $DBI::errstr;
56 while(my $row = $sth->fetchrow_arrayref) {
57 my ($col, $constname, $seq) = @$row;
58 push(@{$keydata{$constname}}, [ $seq, lc $col ]);
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 ]);
71 # DBD::DB2 doesn't follow the DBI API for ->tables
75 my $dbh = $self->schema->storage->dbh;
76 my @tables = map { lc } $dbh->tables(
77 $self->db_schema ? { TABLE_SCHEM => $self->db_schema } : undef
79 s/\Q$self->{_quoter}\E//g for @tables;
80 s/^.*\Q$self->{_namesep}\E// for @tables;
86 my ($self, $table) = @_;
87 return $self->next::method(uc $table);
91 my ($self, $table) = @_;
93 my $rels = $self->next::method(uc $table);
95 foreach my $rel (@$rels) {
96 $rel->{remote_table} = lc $rel->{remote_table};
102 sub _columns_info_for {
103 my ($self, $table) = @_;
104 return $self->next::method(uc $table);
107 sub _extra_column_info {
108 my ($self, $info) = @_;
111 my ($table, $column) = @$info{qw/TABLE_NAME COLUMN_NAME/};
113 my $dbh = $self->schema->storage->dbh;
114 my $sth = $dbh->prepare_cached(
118 WHERE tabschema = ? AND tabname = ? AND colname = ?
119 AND identity = 'Y' AND generated != ''
122 $sth->execute($self->db_schema, $table, $column);
123 if ($sth->fetchrow_array) {
124 $extra_info{is_auto_increment} = 1;
132 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
133 L<DBIx::Class::Schema::Loader::DBI>
137 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
141 This library is free software; you can redistribute it and/or modify it under
142 the same terms as Perl itself.