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