firming up can_link()

diff --git a/lib/SQL/Translator/Producer/Turnkey.pm b/lib/SQL/Translator/Producer/Turnkey.pm
index 1754d71..57c928b 100644 (file)
--- a/lib/SQL/Translator/Producer/Turnkey.pm
+++ b/lib/SQL/Translator/Producer/Turnkey.pm
@@ -21,7 +21,7 @@ sub init {
 package SQL::Translator::Producer::Turnkey;
 
 # -------------------------------------------------------------------
-# $Id: Turnkey.pm,v 1.3 2003-08-29 08:00:51 allenday Exp $
+# $Id: Turnkey.pm,v 1.4 2003-08-29 08:25:31 allenday Exp $
 # -------------------------------------------------------------------
 # Copyright (C) 2003 Allen Day <allenday@ucla.edu>,
 #                    Brian O'Connor <boconnor@ucla.edu>,
@@ -44,7 +44,7 @@ package SQL::Translator::Producer::Turnkey;
 
 use strict;
 use vars qw[ $VERSION $DEBUG ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/;
 $DEBUG   = 1 unless defined $DEBUG;
 
 use SQL::Translator::Schema::Constants;
@@ -96,7 +96,7 @@ sub produce {
 
 
          my $package = Turnkey::Package->new();
-         $packages{ $package->name } = $package;
+         $packages{ $table->name } = $package;
 
          $package->order( ++$order );
          $package->name( $t->format_package_name($table->name) );
@@ -128,8 +128,8 @@ sub produce {
                  my $lpackage = $packages{$left->name};
                  my $rpackage = $packages{$right->name};
 
-warn $left->name, "\t", $right->name;
                  my($link,$lconstraints,$rconstraints) = @{ $maylink->can_link($left,$right) };
+warn $left->name, "\t", $maylink->name, "\t", $right->name if $link ne '0';
 
                  #one FK to one FK
                  if( $link eq 'one2one'){
@@ -152,6 +152,8 @@ warn "\tmany2one";
                  #many FK to many FK
                  } elsif( $link eq 'many2many'){
 warn "\tmany2many";
+warn $left->name;
+warn $right->name;
                        $lpackage->many2many_push($rpackage->name, [$rpackage, $maylink]);
                        $rpackage->many2many_push($lpackage->name, [$lpackage, $maylink]);
 

diff --git a/lib/SQL/Translator/Schema/Table.pm b/lib/SQL/Translator/Schema/Table.pm
index fc29754..2163b9e 100644 (file)
--- a/lib/SQL/Translator/Schema/Table.pm
+++ b/lib/SQL/Translator/Schema/Table.pm
@@ -1,7 +1,7 @@
 package SQL::Translator::Schema::Table;
 
 # ----------------------------------------------------------------------
-# $Id: Table.pm,v 1.16 2003-08-29 08:00:51 allenday Exp $
+# $Id: Table.pm,v 1.17 2003-08-29 08:25:32 allenday Exp $
 # ----------------------------------------------------------------------
 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>
 #
@@ -51,7 +51,7 @@ use Data::Dumper;
 use base 'Class::Base';
 use vars qw( $VERSION $FIELD_ORDER );
 
-$VERSION = sprintf "%d.%02d", q$Revision: 1.16 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.17 $ =~ /(\d+)\.(\d+)/;
 
 # ----------------------------------------------------------------------
 sub init {
@@ -460,46 +460,45 @@ Determine whether the table can link two arg tables via many-to-many.
   my %fk = ();
 
   foreach my $field ($self->get_fields){
-       #if the table has non-key fields, it can't be a link
-       if(!$field->is_primary_key and !$field->is_foreign_key){
-         $self->{'can_link'}{$table1->name}{$table2->name} = [0];
-         $self->{'can_link'}{$table2->name}{$table1->name} = [0];
-         return $self->{'can_link'}{$table1->name}{$table2->name};
-
-       #otherwise, count up how many fields refer to each FK table.field
-       } elsif($field->is_foreign_key){
-         push @{ $fk{$field->foreign_key_reference->reference_table->name} }, $field->foreign_key_reference;
+       if($field->is_foreign_key){
+         push @{ $fk{$field->foreign_key_reference->reference_table} }, $field->foreign_key_reference;
        }
   }
 
+  if(!defined($fk{ $table1->name }) or !defined($fk{ $table2->name })){
+       $self->{'can_link'}{$table1->name}{$table2->name} = [0];
+       $self->{'can_link'}{$table2->name}{$table1->name} = [0];
+       return $self->{'can_link'}{$table1->name}{$table2->name};
+  }
+
   #trivial traversal, only one way to link the two tables
-  if(scalar($fk{ $table1->name } == 1)
+  if(scalar(@{$fk{ $table1->name } } == 1)
         and
-        scalar($fk{ $table2->name } == 1)
+        scalar(@{$fk{ $table2->name } } == 1)
        ){
        $self->{'can_link'}{$table1->name}{$table2->name} = ['one2one', $fk{$table1->name}, $fk{$table2->name}];
        $self->{'can_link'}{$table1->name}{$table2->name} = ['one2one', $fk{$table2->name}, $fk{$table1->name}];
 
   #non-trivial traversal.  one way to link table2, many ways to link table1
-  } elsif(scalar($fk{ $table1->name }  > 1)
+  } elsif(scalar(@{ $fk{ $table1->name } }  > 1)
                  and
-                 scalar($fk{ $table2->name } == 1)
+                 scalar(@{ $fk{ $table2->name } } == 1)
                 ){
        $self->{'can_link'}{$table1->name}{$table2->name} = ['many2one', $fk{$table1->name}, $fk{$table2->name}];
        $self->{'can_link'}{$table2->name}{$table1->name} = ['one2many', $fk{$table2->name}, $fk{$table1->name}];
 
   #non-trivial traversal.  one way to link table1, many ways to link table2
-  } elsif(scalar($fk{ $table1->name } == 1)
+  } elsif(scalar(@{ $fk{ $table1->name } } == 1)
                  and
-                 scalar($fk{ $table2->name }  > 1)
+                 scalar(@{ $fk{ $table2->name } }  > 1)
                 ){
        $self->{'can_link'}{$table1->name}{$table2->name} = ['one2many', $fk{$table1->name}, $fk{$table2->name}];
        $self->{'can_link'}{$table2->name}{$table1->name} = ['many2one', $fk{$table2->name}, $fk{$table1->name}];
 
   #non-trivial traversal.  many ways to link table1 and table2
-  } elsif(scalar($fk{ $table1->name }  > 1)
+  } elsif(scalar(@{ $fk{ $table1->name } }  > 1)
                  and
-                 scalar($fk{ $table2->name }  > 1)
+                 scalar(@{ $fk{ $table2->name } }  > 1)
                 ){
        $self->{'can_link'}{$table1->name}{$table2->name} = ['many2many', $fk{$table1->name}, $fk{$table2->name}];
        $self->{'can_link'}{$table2->name}{$table1->name} = ['many2many', $fk{$table2->name}, $fk{$table1->name}];