X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI%2FDB2.pm;h=886a45b7623d4a6b1aabb1c4e1992bd3a2ab563b;hb=bc1cb85e84e6a30c75763edd478378a68009c722;hp=01c0c281bcf8a9a062db049911974a971060dc22;hpb=e344eed6c9cf62f2e5e78a31d8c499014a16c68c;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm b/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm index 01c0c28..886a45b 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm @@ -2,11 +2,14 @@ package DBIx::Class::Schema::Loader::DBI::DB2; use strict; use warnings; -use base 'DBIx::Class::Schema::Loader::DBI'; +use base qw/ + DBIx::Class::Schema::Loader::DBI::Component::QuotedDefault + DBIx::Class::Schema::Loader::DBI +/; use Carp::Clan qw/^DBIx::Class/; use Class::C3; -our $VERSION = '0.04999_02'; +our $VERSION = '0.07000'; =head1 NAME @@ -27,6 +30,19 @@ See L. =cut +sub _setup { + my $self = shift; + + $self->next::method(@_); + + my $dbh = $self->schema->storage->dbh; + $self->{db_schema} ||= $dbh->selectrow_array('VALUES(CURRENT_USER)', {}); + + if (not defined $self->preserve_case) { + $self->preserve_case(0); + } +} + sub _table_uniq_info { my ($self, $table) = @_; @@ -37,11 +53,12 @@ sub _table_uniq_info { my $sth = $self->{_cache}->{db2_uniq} ||= $dbh->prepare( q{SELECT kcu.COLNAME, kcu.CONSTNAME, kcu.COLSEQ FROM SYSCAT.TABCONST as tc - JOIN SYSCAT.KEYCOLUSE as kcu ON tc.CONSTNAME = kcu.CONSTNAME + JOIN SYSCAT.KEYCOLUSE as kcu + ON tc.CONSTNAME = kcu.CONSTNAME AND tc.TABSCHEMA = kcu.TABSCHEMA WHERE tc.TABSCHEMA = ? and tc.TABNAME = ? and tc.TYPE = 'U'} ) or die $DBI::errstr; - $sth->execute($self->db_schema, $table) or die $DBI::errstr; + $sth->execute($self->db_schema, uc $table) or die $DBI::errstr; my %keydata; while(my $row = $sth->fetchrow_arrayref) { @@ -59,11 +76,84 @@ sub _table_uniq_info { return \@uniqs; } +# DBD::DB2 doesn't follow the DBI API for ->tables +sub _tables_list { + my ($self, $opts) = @_; + + my $dbh = $self->schema->storage->dbh; + my @tables = map { lc } $dbh->tables( + $self->db_schema ? { TABLE_SCHEM => $self->db_schema } : undef + ); + s/\Q$self->{_quoter}\E//g for @tables; + s/^.*\Q$self->{_namesep}\E// for @tables; + + return $self->_filter_tables(\@tables, $opts); +} + +sub _table_pk_info { + my ($self, $table) = @_; + return $self->next::method(uc $table); +} + +sub _table_fk_info { + my ($self, $table) = @_; + + my $rels = $self->next::method(uc $table); + + foreach my $rel (@$rels) { + $rel->{remote_table} = lc $rel->{remote_table}; + } + + return $rels; +} + +sub _columns_info_for { + my $self = shift; + my ($table) = @_; + + my $result = $self->next::method(uc $table); + + my $dbh = $self->schema->storage->dbh; + + while (my ($col, $info) = each %$result) { + # check for identities + my $sth = $dbh->prepare_cached( + q{ + SELECT COUNT(*) + FROM syscat.columns + WHERE tabschema = ? AND tabname = ? AND colname = ? + AND identity = 'Y' AND generated != '' + }, + {}, 1); + $sth->execute($self->db_schema, uc $table, uc $col); + if ($sth->fetchrow_array) { + $info->{is_auto_increment} = 1; + } + + if (eval { lc ${ $info->{default_value} } }||'' eq 'current timestamp') { + ${ $info->{default_value} } = 'CURRENT_TIMESTAMP'; + delete $info->{size}; + } + } + + return $result; +} + =head1 SEE ALSO L, L, L +=head1 AUTHOR + +See L and L. + +=head1 LICENSE + +This library is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + =cut 1; +# vim:et sts=4 sw=4 tw=0: