bugfixes in Class::DBI method generation. they were caused by bad schema

graph representation, which were in turn caused by unexpected (and poorly
documented) Class::MakeMethods::Template::Hash behavior.

diff --git a/lib/SQL/Translator/Producer/Turnkey.pm b/lib/SQL/Translator/Producer/Turnkey.pm
index b195d0d..9ae964a 100644 (file)
--- a/lib/SQL/Translator/Producer/Turnkey.pm
+++ b/lib/SQL/Translator/Producer/Turnkey.pm
@@ -1,7 +1,7 @@
 package SQL::Translator::Producer::Turnkey;
 
 # -------------------------------------------------------------------
-# $Id: Turnkey.pm,v 1.33 2004-04-03 04:01:13 allenday Exp $
+# $Id: Turnkey.pm,v 1.34 2004-04-06 00:27:02 allenday Exp $
 # -------------------------------------------------------------------
 # Copyright (C) 2002-4 SQLFairy Authors
 #
@@ -22,7 +22,7 @@ package SQL::Translator::Producer::Turnkey;
 
 use strict;
 use vars qw[ $VERSION $DEBUG ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.33 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.34 $ =~ /(\d+)\.(\d+)/;
 $DEBUG   = 1 unless defined $DEBUG;
 
 use SQL::Translator::Schema::Constants;
@@ -148,6 +148,8 @@ sub translateForm {
   my $t = shift;
   my $meta = shift;
 
+  $meta->{_dumper} = \&_dumper;
+
   my $args = $t->producer_args;
   my $type = $meta->{'template'};
 
@@ -179,6 +181,15 @@ sub translateForm {
   return($result);
 }
 
+sub _dumper($) {
+  my $s = shift;
+  warn $s;
+
+  my $d = Data::Dumper($s);
+  warn $d;
+  return $d;
+}
+
 1;
 
 # -------------------------------------------------------------------
@@ -304,6 +315,7 @@ sub [% h.thatnode.table.name %]s { my \$self = shift; return map \$_->[% h.thatv
     [% thisnode = h.thisnode_index(0) %]
     [% i = 0 %]
     [% FOREACH thatnode = h.thatnode %]
+      [% NEXT UNLESS h.thisviafield_index(i).name %]
 #[% thisnode.name %]::[% h.thisfield_index(0).name %] -> [% h.vianode.name %]::[% h.thisviafield_index(i).name %] ... [% h.vianode.name %]::[% h.thatviafield_index(0).name %] <- [% h.thatnode_index(0).name %]::[% h.thatfield_index(0).name %]
 sub [% h.vianode.table.name %]_[% format_fk(h.vianode,h.thatviafield_index(0).name) %]s { my \$self = shift; return map \$_->[% h.thatviafield_index(0).name %], \$self->[% h.vianode.table.name %]_[% h.thisviafield_index(i).name %] }
       [% i = i + 1 %]

diff --git a/lib/SQL/Translator/Schema/Graph.pm b/lib/SQL/Translator/Schema/Graph.pm
index 537ed6d..e63b90f 100644 (file)
--- a/lib/SQL/Translator/Schema/Graph.pm
+++ b/lib/SQL/Translator/Schema/Graph.pm
@@ -74,17 +74,23 @@ sub init {
                                                   thatfield => $self->translator->schema->get_table($field->foreign_key_reference->reference_table)->get_field(($field->foreign_key_reference->reference_fields)[0])
                                                  );
 
+#        $node->edgecount($that->name, $node->edgecount($that->name)+1);
          $node->edgecount($that->name, $node->edgecount($that->name)+1);
 
          $node->has($that->name, $node->has($that->name)+1);
          $that->many($node->name, $that->many($node->name)+1);
 
+#        $that->edgecount($node->name, $that->edgecount($node->name)+1);
          $that->edgecount($node->name, $that->edgecount($node->name)+1);
-#warn $node->name . "\t" . $that->edgecount($node->name);
+
+      #warn "\t" . $node->name . "\t" . $node->edgecount($that->name);
          $node->push_edges( $edge );
          $that->push_edges( $edge->flip );
       }
        }
+
+    #warn Dumper($node->edgecount());
+    #warn "*****";
   }
 
   #

diff --git a/lib/SQL/Translator/Schema/Graph/Node.pm b/lib/SQL/Translator/Schema/Graph/Node.pm
index db91c6c..c0aa862 100644 (file)
--- a/lib/SQL/Translator/Schema/Graph/Node.pm
+++ b/lib/SQL/Translator/Schema/Graph/Node.pm
@@ -7,9 +7,32 @@ use Class::MakeMethods::Template::Hash (
   'array_of_objects -class SQL::Translator::Schema::Graph::Edge' => [ qw( edges ) ],
   'array_of_objects -class SQL::Translator::Schema::Graph::CompoundEdge' => [ qw( compoundedges ) ],
   'array_of_objects -class SQL::Translator::Schema::Graph::HyperEdge' => [ qw( hyperedges ) ],
-  'hash' => [ qw( many via has edgecount data_fields) ],
+  #'hash' => [ qw( many via has edgecount data_fields) ],
+  'hash' => [ qw( many via has data_fields) ],
   scalar => [ qw( base name order primary_key primary_key_accessor table is_trivial_link ) ],
   number => [ qw( order ) ],
 );
 
+sub edgecount {
+  my($self) = shift;
+
+  $self->{_edgecount} ||= {};
+
+  if(scalar(@_) == 1){
+    my $k = shift;
+    return $self->{_edgecount}{$k};
+  } elsif(@_) {
+    my %arg = @_;
+
+    foreach my $k (keys %arg){
+      #warn $a,"\t",$arg{$k};
+      $self->{_edgecount}{$k} = $arg{$k};
+    }
+
+    return %arg;
+  } else {
+    return $self->{_edgecount};
+  }
+}
+
 1;