From: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
Date: Wed, 12 Mar 2008 01:49:17 +0000 (+0000)
Subject: Fix DB2 support:
X-Git-Tag: 0.04006~18
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a168c1c4a411941fd0e9d1cbf8cfc24761f71b20;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

Fix DB2 support:
 - foreign_key_info needs the PK schema name
 - up/down-case table names when going to/from the DB
---

diff --git a/Changes b/Changes
index 88a594a..4c59009 100644
--- 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
diff --git a/lib/DBIx/Class/Schema/Loader/DBI.pm b/lib/DBIx/Class/Schema/Loader/DBI.pm
index 10c51fc..9d6d0ea 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI.pm
@@ -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;
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm b/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm
index 800a2bb..7d1716e 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm
@@ -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>,