Crazy ass multi create fixes..
Jess Robinson [Sat, 22 Nov 2008 22:36:58 +0000 (22:36 +0000)]
1. pass back temp objects when checking pks for rels
2. sanitise (!?) pk_depends_on
3. set in_storage(1) just after actual insert, before inserting related objs

lib/DBIx/Class/Relationship/Base.pm
lib/DBIx/Class/ResultSource.pm
lib/DBIx/Class/Row.pm

index f78bb6b..f07882b 100644 (file)
@@ -403,9 +403,11 @@ sub set_from_related {
     $self->throw_exception( "Object $f_obj isn't a ".$f_class )
       unless Scalar::Util::blessed($f_obj) and $f_obj->isa($f_class);
   }
+#  print STDERR "set_from_related: ", $rel, Data::Dumper::Dumper({$f_obj->get_columns});
   $self->set_columns(
     $self->result_source->resolve_condition(
        $rel_obj->{cond}, $f_obj, $rel));
+#  print STDERR "set_: ", Data::Dumper::Dumper({$self->get_columns});
   return 1;
 }
 
index 83ad7cc..7c3add8 100644 (file)
@@ -778,12 +778,16 @@ sub resolve_join {
 
 Determines whether a relation is dependent on an object from this source
 having already been inserted. Takes the name of the relationship and a
-hashref of columns of the related object.
+hashref of already known columns of the related object.
 
 =cut
 
+## true if: our PK depends on the data from the given rel
+## AND its not yet in the rel_data passed
+## pk_still_unsolved? pk_has_unmet_deps?
 sub pk_depends_on {
-  my ($self, $relname, $rel_data) = @_;
+  my ($self, $relname, $rel_data, $existing_data) = @_;
+#  print STDERR "Rel $relname on ", $self->source_name, " ", Data::Dumper::Dumper($self->relationship_info($relname));
   my $cond = $self->relationship_info($relname)->{cond};
 
   return 0 unless ref($cond) eq 'HASH';
@@ -799,16 +803,81 @@ sub pk_depends_on {
   my $rel_source = $self->related_source($relname);
 
   foreach my $p ($self->primary_columns) {
-    if (exists $keyhash->{$p}) {
-      unless (defined($rel_data->{$keyhash->{$p}})
-              || $rel_source->column_info($keyhash->{$p})
-                            ->{is_auto_increment}) {
-        return 0;
+#      print "Checking if $p is still needed\n";
+      
+      if (exists $keyhash->{$p}) {
+          my $rel_val = $keyhash->{$p};
+#          print STDERR "PK col $p, val=$rel_val\n";
+          # This column of self is autoinc.  It is never needed.
+          if ($self->column_info($p)->{is_auto_increment}) {
+#              print STDERR "$p is autoinc, already resolved\n";
+              next;
+          }
+
+          # This column already has data provided.  (Existing_data should
+          # be hard data only, not refs to things not yet there!)
+          if (defined $existing_data->{$p}) {
+#              print STDERR "$p is in existing data, already resolved\n";
+              next;
+          }
+
+          # Already is provided for by this relationship.
+          if (defined $rel_data->{$rel_val}) {
+#              print STDERR "$p is already resolved by this relationship (to $relname.$rel_val)\n";
+              next;
+          }
+
+          # Can be provided by the relationship that we are currently
+          # looking at.  Money-shot.
+          if ($rel_source->column_info($rel_val)->{is_auto_increment}) {
+#              print STDERR "$p *WOULD BE* resolved by this relationship (but isn't yet).\n";
+              return 1;
+          }
+
+          # Can this be provided by the relationship that we are
+          # currently looking at?  Well, first the thing this is
+          # related to needs to be able to provide it for
+          # itself... which is what the function we are now writing is
+          # supposed to find out.  Recurse.
+          for ($rel_source->relationships) {
+              # We need to skip the reverse relationship, or we will
+              # often recurse infinitely.
+              next if $_ eq (keys %{$self->reverse_relationship_info($relname)})[0];
+              # Do we need to skip the entire call stack's worth of
+              # backrelationships?  If so, we need a skiplist argument
+              # to this function -- easy to do, since we don't have
+              # any final arguments.
+              if ($rel_source->pk_depends_on($_, {}, $rel_data)) {
+                  # If this relationship can resolve it, then this pk field
+                  # can be resolved by $relname.
+#                  print "$p *WOULD BE* resolved by this relationship (but isn't yet).\n";
+                  return 1;
+              }
+          }
+
+          # Bad, we are dependent.
+#          print "Unresolved PK column $p, but it cannot be resolved by this relationship\n";
+          return 0;
+#       unless (defined($rel_data->{$keyhash->{$p}})
+# # foreign col might be an fk itself, and not auto-inc!
+#               || $rel_source->column_info($keyhash->{$p})
+#                   ->{is_auto_increment}
+# # but only if its not an fk to the one we were asking about!
+#               || ( $rel_source->column_info($keyhash->{$p})
+#                   ->{is_foreign_key} 
+#                    && $self->relationship_info($relname)->{attrs}{accessor} eq 'single'
+#               )) {
+# # This needs to be true if this col is an fk on rel_source
+# #              || !$rel_source->relationship_info($p) ) {
+#         print STDERR "not dependant\n";
+#         return 0;
+# #        return $p;
+#      }
       }
-    }
   }
 
-  return 1;
+#  print STDERR "not dependant\n";
+  return 0;
 }
 
 =head2 resolve_condition
index c1fb2b0..d35d299 100644 (file)
@@ -78,17 +78,21 @@ For a more involved explanation, see L<DBIx::Class::ResultSet/create>.
 sub __new_related_find_or_new_helper {
   my ($self, $relname, $data) = @_;
   if ($self->__their_pk_needs_us($relname, $data)) {
+#    print STDERR "PK needs us\n";
+#    print STDERR "Data: ", Data::Dumper::Dumper($data);
     return $self->result_source
                 ->related_source($relname)
                 ->resultset
                 ->new_result($data);
   }
   if ($self->result_source->pk_depends_on($relname, $data)) {
+#      print STDERR "PK depends on\n";
     return $self->result_source
                 ->related_source($relname)
                 ->resultset
                 ->find_or_create($data);
   }
+#  print STDERR "Neither, find_or_new\n";
   return $self->find_or_new_related($relname, $data);
 }
 
@@ -96,12 +100,20 @@ sub __their_pk_needs_us { # this should maybe be in resultsource.
   my ($self, $relname, $data) = @_;
   my $source = $self->result_source;
   my $reverse = $source->reverse_relationship_info($relname);
+#  print STDERR "Found reverse rel info: ", Data::Dumper::Dumper($reverse);
   my $rel_source = $source->related_source($relname);
   my $us = { $self->get_columns };
+#  print STDERR "Test on self cols: ", Data::Dumper::Dumper($us);
   foreach my $key (keys %$reverse) {
     # if their primary key depends on us, then we have to
     # just create a result and we'll fill it out afterwards
-    return 1 if $rel_source->pk_depends_on($key, $us);
+    my $dep = $rel_source->pk_depends_on($key, $us);
+    if($dep) {
+#        print STDERR "Assigning $self to $key\n";
+        $data->{$key} = $self;
+        return 1;
+    }
+#    return 1 if $rel_source->pk_depends_on($key, $us);
   }
   return 0;
 }
@@ -124,6 +136,7 @@ sub new {
     $new->result_source($source);
   }
 
+#  print "Source ", $source->source_name, " is $new\n";
   if ($attrs) {
     $new->throw_exception("attrs must be a hashref")
       unless ref($attrs) eq 'HASH';
@@ -140,6 +153,8 @@ sub new {
         if ($info && $info->{attrs}{accessor}
           && $info->{attrs}{accessor} eq 'single')
         {
+#          print STDERR "Single $key ", Data::Dumper::Dumper($attrs);
+#          print STDERR "from $class to: $info->{class}\n";
           my $rel_obj = delete $attrs->{$key};
           if(!Scalar::Util::blessed($rel_obj)) {
             $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
@@ -149,10 +164,13 @@ sub new {
 
           $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
           $related->{$key} = $rel_obj;
+#          print STDERR "Related :", join(", ", keys %$related), "\n";
           next;
         } elsif ($info && $info->{attrs}{accessor}
             && $info->{attrs}{accessor} eq 'multi'
             && ref $attrs->{$key} eq 'ARRAY') {
+#          print STDERR "Multi $key ", Data::Dumper::Dumper($attrs);
+#          print STDERR "from $class to: $info->{class}\n";
           my $others = delete $attrs->{$key};
           foreach my $rel_obj (@$others) {
             if(!Scalar::Util::blessed($rel_obj)) {
@@ -163,6 +181,7 @@ sub new {
             $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
           }
           $related->{$key} = $others;
+#          print STDERR "Related :", join(", ", keys %$related), "\n";
           next;
         } elsif ($info && $info->{attrs}{accessor}
           && $info->{attrs}{accessor} eq 'filter')
@@ -180,6 +199,7 @@ sub new {
           $inflated->{$key} = $attrs->{$key};
           next;
         }
+#          print STDERR "Done :", join(", ", keys %$related), "\n";
       }
       $new->throw_exception("No such column $key on $class")
         unless $class->has_column($key);
@@ -246,24 +266,33 @@ sub insert {
     my @pri = $self->primary_columns;
 
     REL: foreach my $relname (keys %related_stuff) {
-
+#        print STDERR "Looking at: $relname\n";
       my $rel_obj = $related_stuff{$relname};
 
       next REL unless (Scalar::Util::blessed($rel_obj)
                        && $rel_obj->isa('DBIx::Class::Row'));
 
+#        print STDERR "Check pk: from ", $source->source_name, " to $relname\n";
+#        print STDERR "With ", Data::Dumper::Dumper({ $rel_obj->get_columns });
       next REL unless $source->pk_depends_on(
                         $relname, { $rel_obj->get_columns }
                       );
-
+#        print STDERR "$rel_obj\n";
+#        print STDERR "in_storage: ", $rel_obj->in_storage, "\n";
+#        print STDERR "Inserting $relname\n";
       $rel_obj->insert();
       $self->set_from_related($relname, $rel_obj);
       delete $related_stuff{$relname};
     }
   }
 
+#  print STDERR "self $self\n";
+#  print STDERR "self in_storage ", $self->in_storage, "\n";
+#  print STDERR "Ran out of rels, insert ", $source->source_name, "\n";
   my $updated_cols = $source->storage->insert($source, { $self->get_columns });
   $self->set_columns($updated_cols);
+  $self->in_storage(1);
+#  print STDERR "$self\n";
 
   ## PK::Auto
   my @auto_pri = grep {
@@ -302,10 +331,15 @@ sub insert {
         my $reverse = $source->reverse_relationship_info($relname);
         foreach my $obj (@cands) {
           $obj->set_from_related($_, $self) for keys %$reverse;
-          my $them = { %{$obj->{_relationship_data} || {} }, $obj->get_inflated_columns };
+#          my $them = { %{$obj->{_relationship_data} || {} }, $obj->get_inflated_columns };
+          my $them = { $obj->get_inflated_columns };
+#          print STDERR "Does $relname need our PK?\n";
           if ($self->__their_pk_needs_us($relname, $them)) {
-            $obj = $self->find_or_create_related($relname, $them);
+#              print STDERR "Yes\n";
+            # $obj = $self->find_or_create_related($relname, $them);
+            $obj->insert();
           } else {
+#              print STDERR "No\n";
             $obj->insert();
           }
         }
@@ -314,7 +348,7 @@ sub insert {
     $rollback_guard->commit;
   }
 
-  $self->in_storage(1);
+#  $self->in_storage(1);
   undef $self->{_orig_ident};
   return $self;
 }