schema-loader does multi-column FKs now, needs a bit of cleanup/refactor work

[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / DB2.pm

diff --git a/lib/DBIx/Class/Schema/Loader/DB2.pm b/lib/DBIx/Class/Schema/Loader/DB2.pm
index 70a22b6..a6de578 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/DB2.pm
+++ b/lib/DBIx/Class/Schema/Loader/DB2.pm
@@ -2,7 +2,6 @@ package DBIx::Class::Schema::Loader::DB2;
 
 use strict;
 use base 'DBIx::Class::Schema::Loader::Generic';
-use DBI;
 use Carp;
 
 =head1 NAME
@@ -15,12 +14,11 @@ DBIx::Class::Schema::Loader::DB2 - DBIx::Class::Schema::Loader DB2 Implementatio
 
   # $loader is a DBIx::Class::Schema::Loader::DB2
   my $loader = DBIx::Class::Schema::Loader->new(
-    dsn       => "dbi:DB2:dbname",
-    user      => "myuser",
-    password  => "",
-    namespace => "Data",
-    schema    => "MYSCHEMA",
-    dropschema  => 0,
+    dsn         => "dbi:DB2:dbname",
+    user        => "myuser",
+    password    => "",
+    db_schema   => "MYSCHEMA",
+    drop_schema => 1,
   );
 
 =head1 DESCRIPTION
@@ -30,14 +28,14 @@ See L<DBIx::Class::Schema::Loader>.
 =cut
 
 sub _db_classes {
-   return ();
+    return qw/DBIx::Class::PK::Auto::DB2/;
 }
 
 sub _tables {
-    my $self = shift;
+    my $class = shift;
     my %args = @_; 
-    my $db_schema = uc ($args{db_schema} || '');
-    my $dbh = $self->{_storage}->dbh;
+    my $db_schema = uc $class->loader_data->{_db_schema};
+    my $dbh = $class->storage->dbh;
 
     # this is split out to avoid version parsing errors...
     my $is_dbd_db2_gte_114 = ( $DBD::DB2::VERSION >= 1.14 );
@@ -53,14 +51,14 @@ sub _tables {
 }
 
 sub _table_info {
-    my ( $self, $table ) = @_;
+    my ( $class, $table ) = @_;
 #    $|=1;
 #    print "_table_info($table)\n";
     my ($db_schema, $tabname) = split /\./, $table, 2;
     # print "DB_Schema: $db_schema, Table: $tabname\n";
     
     # FIXME: Horribly inefficient and just plain evil. (JMM)
-    my $dbh = $self->{_storage}->dbh;
+    my $dbh = $class->storage->dbh;
     $dbh->{RaiseError} = 1;
 
     my $sth = $dbh->prepare(<<'SQL') or die;
@@ -70,7 +68,9 @@ WHERE c.TABSCHEMA = ? and c.TABNAME = ?
 SQL
 
     $sth->execute($db_schema, $tabname) or die;
-    my @cols = map { @$_ } @{$sth->fetchall_arrayref};
+    my @cols = map { lc } map { @$_ } @{$sth->fetchall_arrayref};
+
+    $sth->finish;
 
     $sth = $dbh->prepare(<<'SQL') or die;
 SELECT kcu.COLNAME
@@ -81,11 +81,52 @@ SQL
 
     $sth->execute($db_schema, $tabname) or die;
 
-    my @pri = map { @$_ } @{$sth->fetchall_arrayref};
+    my @pri = map { lc } map { @$_ } @{$sth->fetchall_arrayref};
+
+    $sth->finish;
     
     return ( \@cols, \@pri );
 }
 
+# Find and setup relationships
+sub _relationships {
+    my $class = shift;
+
+    my $dbh = $class->storage->dbh;
+
+    my $sth = $dbh->prepare(<<'SQL') or die;
+SELECT SR.COLCOUNT, SR.REFTBNAME, SR.PKCOLNAMES, SR.FKCOLNAMES
+FROM SYSIBM.SYSRELS SR WHERE SR.TBNAME = ?
+SQL
+
+    foreach my $table ( $class->tables ) {
+        if ($sth->execute(uc $table)) {
+            while(my $res = $sth->fetchrow_arrayref()) {
+                my ($colcount, $other, $other_column, $column) =
+                    map { lc } @$res;
+
+                my @self_cols = split(' ',$column);
+                my @other_cols = split(' ',$other_column);
+                if(@self_cols != $colcount || @other_cols != $colcount) {
+                    die "Column count discrepancy while getting rel info";
+                }
+
+                my %cond;
+                for(my $i = 0; $i < @self_cols; $i++) {
+                    $cond{$other_cols[$i]} = $self_cols[$i];
+                }
+
+                eval { $class->_belongs_to_many ($table, $other, \%cond); };
+                warn qq/\# belongs_to_many failed "$@"\n\n/
+                  if $@ && $class->debug_loader;
+            }
+        }
+    }
+
+    $sth->finish;
+    $dbh->disconnect;
+}
+
 =head1 SEE ALSO
 
 L<DBIx::Class::Schema::Loader>