X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI%2FDB2.pm;h=805fab0418279a43c8b79282844a06ae63f10fa4;hb=46564a42215c5309753f3e0609ae1adddf68d083;hp=598d8cc628cce8cbdb7f585589173b4ab43adc75;hpb=f671b6308c4f2210255b2eaa12fc47a49621d436;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 598d8cc..805fab0 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm @@ -6,44 +6,50 @@ use base qw/ DBIx::Class::Schema::Loader::DBI::Component::QuotedDefault DBIx::Class::Schema::Loader::DBI /; -use Carp::Clan qw/^DBIx::Class/; use mro 'c3'; -our $VERSION = '0.07002'; +use List::Util 'any'; +use namespace::clean; -=head1 NAME - -DBIx::Class::Schema::Loader::DBI::DB2 - DBIx::Class::Schema::Loader::DBI DB2 Implementation. +use DBIx::Class::Schema::Loader::Table (); -=head1 SYNOPSIS +our $VERSION = '0.07048_01'; - package My::Schema; - use base qw/DBIx::Class::Schema::Loader/; - - __PACKAGE__->loader_options( db_schema => "MYSCHEMA" ); +=head1 NAME - 1; +DBIx::Class::Schema::Loader::DBI::DB2 - DBIx::Class::Schema::Loader::DBI DB2 Implementation. =head1 DESCRIPTION -See L. +See L and L. =cut +sub _system_schemas { + my $self = shift; + + return ($self->next::method(@_), qw/ + SYSCAT SYSIBM SYSIBMADM SYSPUBLIC SYSSTAT SYSTOOLS + /); +} + sub _setup { my $self = shift; $self->next::method(@_); - my $dbh = $self->schema->storage->dbh; - $self->{db_schema} ||= $dbh->selectrow_array('VALUES(CURRENT_USER)', {}); + my $ns = $self->name_sep; + + $self->db_schema([ $self->dbh->selectrow_array(<<"EOF", {}) ]) unless $self->db_schema; +SELECT CURRENT_SCHEMA FROM sysibm${ns}sysdummy1 +EOF if (not defined $self->preserve_case) { $self->preserve_case(0); } elsif ($self->preserve_case) { $self->schema->storage->sql_maker->quote_char('"'); - $self->schema->storage->sql_maker->name_sep('.'); + $self->schema->storage->sql_maker->name_sep($ns); } } @@ -52,76 +58,129 @@ sub _table_uniq_info { my @uniqs; - my $dbh = $self->schema->storage->dbh; - - 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 AND tc.TABSCHEMA = kcu.TABSCHEMA - WHERE tc.TABSCHEMA = ? and tc.TABNAME = ? and tc.TYPE = 'U'} - ) or die $DBI::errstr; + my $sth = $self->{_cache}->{db2_uniq} ||= $self->dbh->prepare(<<'EOF'); +SELECT kcu.colname, kcu.constname, kcu.colseq +FROM syscat.tabconst as tc +JOIN syscat.keycoluse as kcu + ON tc.constname = kcu.constname + AND tc.tabschema = kcu.tabschema + AND tc.tabname = kcu.tabname +WHERE tc.tabschema = ? and tc.tabname = ? and tc.type = 'U' +EOF - $sth->execute($self->db_schema, $self->_uc($table)) or die $DBI::errstr; + $sth->execute($table->schema, $table->name); my %keydata; while(my $row = $sth->fetchrow_arrayref) { my ($col, $constname, $seq) = @$row; push(@{$keydata{$constname}}, [ $seq, $self->_lc($col) ]); } - foreach my $keyname (keys %keydata) { + foreach my $keyname (sort keys %keydata) { my @ordered_cols = map { $_->[1] } sort { $a->[0] <=> $b->[0] } @{$keydata{$keyname}}; push(@uniqs, [ $keyname => \@ordered_cols ]); } $sth->finish; - + 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 $self->_lc($_), $dbh->tables( - $self->db_schema ? { TABLE_SCHEM => $self->db_schema } : undef +sub _table_fk_info { + my ($self, $table) = @_; + + my $sth = $self->{_cache}->{db2_fk} ||= $self->dbh->prepare(<<'EOF'); +SELECT tc.constname, sr.reftabschema, sr.reftabname, + kcu.colname, rkcu.colname, kcu.colseq, + sr.deleterule, sr.updaterule +FROM syscat.tabconst tc +JOIN syscat.keycoluse kcu + ON tc.constname = kcu.constname + AND tc.tabschema = kcu.tabschema + AND tc.tabname = kcu.tabname +JOIN syscat.references sr + ON tc.constname = sr.constname + AND tc.tabschema = sr.tabschema + AND tc.tabname = sr.tabname +JOIN syscat.keycoluse rkcu + ON sr.refkeyname = rkcu.constname + AND sr.reftabschema = rkcu.tabschema + AND sr.reftabname = rkcu.tabname + AND kcu.colseq = rkcu.colseq +WHERE tc.tabschema = ? + AND tc.tabname = ? + AND tc.type = 'F'; +EOF + $sth->execute($table->schema, $table->name); + + my %rels; + + my %rules = ( + A => 'NO ACTION', + C => 'CASCADE', + N => 'SET NULL', + R => 'RESTRICT', ); - s/\Q$self->{_quoter}\E//g for @tables; - s/^.*\Q$self->{_namesep}\E// for @tables; - return $self->_filter_tables(\@tables, $opts); -} + COLS: while (my @row = $sth->fetchrow_array) { + my ($fk, $remote_schema, $remote_table, $local_col, $remote_col, + $colseq, $delete_rule, $update_rule) = @row; -sub _table_pk_info { - my ($self, $table) = @_; - return $self->next::method($self->_uc($table)); -} + if (not exists $rels{$fk}) { + if ($self->db_schema && $self->db_schema->[0] ne '%' + && (not any { $_ eq $remote_schema } @{ $self->db_schema })) { -sub _table_fk_info { - my ($self, $table) = @_; + next COLS; + } - my $rels = $self->next::method($self->_uc($table)); + $rels{$fk}{remote_table} = DBIx::Class::Schema::Loader::Table->new( + loader => $self, + name => $remote_table, + schema => $remote_schema, + ); + } - foreach my $rel (@$rels) { - $rel->{remote_table} = $self->_lc($rel->{remote_table}); + $rels{$fk}{local_columns}[$colseq-1] = $self->_lc($local_col); + $rels{$fk}{remote_columns}[$colseq-1] = $self->_lc($remote_col); + + $rels{$fk}{attrs} ||= { + on_delete => $rules{$delete_rule}, + on_update => $rules{$update_rule}, + is_deferrable => 1, # DB2 has no deferrable constraints + }; } - return $rels; + return [ values %rels ]; +} + + +# DBD::DB2 doesn't follow the DBI API for ->tables (pre 1.85), but since its +# backwards compatible we don't change it. +# DBD::DB2 1.85 and beyond default TABLE_NAME to '', previously defaulted to +# '%'. so we supply it. +sub _dbh_tables { + my ($self, $schema) = @_; + + return $self->dbh->tables($schema ? { TABLE_SCHEM => $schema, TABLE_NAME => '%' } : undef); +} + +sub _dbh_table_info { + my $self = shift; + + local $^W = 0; # shut up undef warning from DBD::DB2 + + $self->next::method(@_); } sub _columns_info_for { my $self = shift; my ($table) = @_; - my $result = $self->next::method($self->_uc($table)); - - my $dbh = $self->schema->storage->dbh; + my $result = $self->next::method(@_); while (my ($col, $info) = each %$result) { # check for identities - my $sth = $dbh->prepare_cached( + my $sth = $self->dbh->prepare_cached( q{ SELECT COUNT(*) FROM syscat.columns @@ -129,7 +188,7 @@ sub _columns_info_for { AND identity = 'Y' AND generated != '' }, {}, 1); - $sth->execute($self->db_schema, $self->_uc($table), $self->_uc($col)); + $sth->execute($table->schema, $table->name, $self->_uc($col)); if ($sth->fetchrow_array) { $info->{is_auto_increment} = 1; } @@ -172,7 +231,7 @@ sub _columns_info_for { $info->{data_type} = 'varbinary'; } - my ($size) = $dbh->selectrow_array(<<'EOF', {}, $self->db_schema, $self->_uc($table), $self->_uc($col)); + my ($size) = $self->dbh->selectrow_array(<<'EOF', {}, $table->schema, $table->name, $self->_uc($col)); SELECT length FROM syscat.columns WHERE tabschema = ? AND tabname = ? AND colname = ? @@ -200,9 +259,9 @@ EOF L, L, L -=head1 AUTHOR +=head1 AUTHORS -See L and L. +See L. =head1 LICENSE