Fix DB2 support:
Dagfinn Ilmari Mannsåker [Wed, 12 Mar 2008 01:49:17 +0000 (01:49 +0000)]
 - foreign_key_info needs the PK schema name
 - up/down-case table names when going to/from the DB

Changes
lib/DBIx/Class/Schema/Loader/DBI.pm
lib/DBIx/Class/Schema/Loader/DBI/DB2.pm

diff --git a/Changes b/Changes
index 88a594a..4c59009 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
 Not yet released
+        - Fix DB2 support
         - Add support for load_namespaces-style class layout
         - Fix test skip count for main skip_rels block
         - Fix auto-inc column creation for the Oracle tests
index 10c51fc..9d6d0ea 100644 (file)
@@ -169,8 +169,8 @@ sub _table_fk_info {
     my ($self, $table) = @_;
 
     my $dbh = $self->schema->storage->dbh;
-    my $sth = $dbh->foreign_key_info( '', '', '', '',
-        $self->db_schema, $table );
+    my $sth = $dbh->foreign_key_info( '', $self->db_schema, '',
+                                      '', $self->db_schema, $table );
     return [] if !$sth;
 
     my %rels;
index 800a2bb..7d1716e 100644 (file)
@@ -41,7 +41,7 @@ sub _table_uniq_info {
         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,6 +59,33 @@ sub _table_uniq_info {
     return \@uniqs;
 }
 
+sub _tables_list {
+    my $self = shift;
+    return map lc, $self->next::method;
+}
+
+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, $table) = @_;
+    return $self->next::method(uc $table);
+}
+
 =head1 SEE ALSO
 
 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,