[Bast-commits] r4176 - in trunk/DBIx-Class-Schema-Loader: . lib/DBIx/Class/Schema/Loader lib/DBIx/Class/Schema/Loader/DBI

[ilmari at dev.catalyst.perl.org]

Author: ilmari
Date: 2008-03-12 01:49:17 +0000 (Wed, 12 Mar 2008)
New Revision: 4176

Modified:
   trunk/DBIx-Class-Schema-Loader/Changes
   trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI.pm
   trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm
Log:
Fix DB2 support:
 - foreign_key_info needs the PK schema name
 - up/down-case table names when going to/from the DB

Modified: trunk/DBIx-Class-Schema-Loader/Changes
===================================================================
--- trunk/DBIx-Class-Schema-Loader/Changes	2008-03-11 20:52:59 UTC (rev 4175)
+++ trunk/DBIx-Class-Schema-Loader/Changes	2008-03-12 01:49:17 UTC (rev 4176)
@@ -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

Modified: trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm
===================================================================
--- trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm	2008-03-11 20:52:59 UTC (rev 4175)
+++ trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm	2008-03-12 01:49:17 UTC (rev 4176)
@@ -41,7 +41,7 @@
         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 @@
     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>,

Modified: trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI.pm
===================================================================
--- trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI.pm	2008-03-11 20:52:59 UTC (rev 4175)
+++ trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI.pm	2008-03-12 01:49:17 UTC (rev 4176)
@@ -169,8 +169,8 @@
     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;