From: Matt S Trout <mst@shadowcat.co.uk>
Date: Wed, 20 Jun 2007 04:14:52 +0000 (+0000)
Subject: probably fix bulk_create
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9c6d6d935cf5ef946fafec02a33a3d2415ba706f;p=dbsrgits%2FDBIx-Class-Historic.git

probably fix bulk_create
---

diff --git a/Changes b/Changes
index b1c67ad..7b49884 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for DBIx::Class
 
+        - add scope guard to Row::insert to ensure rollback gets called
+        - more heuristics in Row::insert to try and get insert order right
+        - eliminate vestigial code in PK::Auto
         - more expressive DBI errors
         - soften errors during deploy
         - ensure_connected before txn_begin to catch stomping on transaction
diff --git a/Makefile.PL b/Makefile.PL
index a3375b6..e3fe9a3 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -17,6 +17,7 @@ requires 'Module::Find'              => 0;
 requires 'Class::Inspector'          => 0;
 requires 'Class::Accessor::Grouped'  => 0.05002;
 requires 'JSON'                      => 1.00; 
+requires 'Scope::Guard'              => 0.03;
 
 # Perl 5.8.0 doesn't have utf8::is_utf8()
 requires 'Encode'                    => 0 if ($] <= 5.008000);  
diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index 3dad52d..e5fb4c9 100644
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -6,6 +6,7 @@ use warnings;
 use base qw/DBIx::Class/;
 use Carp::Clan qw/^DBIx::Class/;
 use Scalar::Util ();
+use Scope::Guard;
 
 __PACKAGE__->mk_group_accessors('simple' => qw/_source_handle/);
 
@@ -143,21 +144,45 @@ sub insert {
   $self->throw_exception("No result_source set on this object; can't insert")
     unless $source;
 
+  my $rollback_guard;
+
   # Check if we stored uninserted relobjs here in new()
   my %related_stuff = (%{$self->{_relationship_data} || {}}, 
                        %{$self->{_inflated_column} || {}});
+
   if(!$self->{_rel_in_storage})
   {
+
     $source->storage->txn_begin;
 
+    # The guard will save us if we blow out of this scope via die
+
+    $rollback_guard = Scope::Guard->new(sub { $source->storage->txn_rollback });
+
     ## Should all be in relationship_data, but we need to get rid of the
     ## 'filter' reltype..
     ## These are the FK rels, need their IDs for the insert.
-    foreach my $relname (keys %related_stuff) {
+
+    my @pri = $self->primary_columns;
+
+    REL: foreach my $relname (keys %related_stuff) {
+      my $keyhash = $source->resolve_condition(
+                      $source->relationship_info($relname)->{cond},
+                      undef, 1
+                    ); # the above argset gives me the dependent cols on self
+
+      # assume anything that references our PK probably is dependent on us
+      # rather than vice versa
+
+      foreach my $p (@pri) {
+        next REL if exists $keyhash->{$p};
+      }
+
       my $rel_obj = $related_stuff{$relname};
       if(Scalar::Util::blessed($rel_obj) && $rel_obj->isa('DBIx::Class::Row')) {
         $rel_obj->insert();
         $self->set_from_related($relname, $rel_obj);
+        delete $related_stuff{$relname};
       }
     }
   }
@@ -187,18 +212,24 @@ sub insert {
   {
     ## Now do the has_many rels, that need $selfs ID.
     foreach my $relname (keys %related_stuff) {
-      my $relobj = $related_stuff{$relname};
-      if(ref $relobj eq 'ARRAY') {
-        foreach my $obj (@$relobj) {
-          my $info = $self->relationship_info($relname);
-          ## What about multi-col FKs ?
-          my $key = $1 if($info && (keys %{$info->{cond}})[0] =~ /^foreign\.(\w+)/);
-          $obj->set_from_related($key, $self);
+      my $rel_obj = $related_stuff{$relname};
+      my @cands;
+      if (Scalar::Util::blessed($rel_obj)
+          && $rel_obj->isa('DBIx::Class::Row')) {
+        @cands = ($rel_obj);
+      } elsif (ref $rel_obj eq 'ARRAY') {
+        @cands = @$rel_obj;
+      }
+      if (@cands) {
+        my $reverse = $source->reverse_relationship_info($relname);
+        foreach my $obj (@cands) {
+          $obj->set_from_related($_, $self) for keys %$reverse;
           $obj->insert() if(!$obj->in_storage);
         }
       }
     }
     $source->storage->txn_commit;
+    $rollback_guard->dismiss;
   }
 
   $self->in_storage(1);
diff --git a/t/96multi_create.t b/t/96multi_create.t
index 23badf9..4f32e68 100644
--- a/t/96multi_create.t
+++ b/t/96multi_create.t
@@ -1,14 +1,12 @@
 use strict;
 use warnings;
 
-use Test::More;
+use Test::More qw(no_plan);
 use lib qw(t/lib);
 use DBICTest;
 
 my $schema = DBICTest->init_schema();
 
-plan tests => 17;
-
 my $cd2 = $schema->resultset('CD')->create({ artist => 
                                    { name => 'Fred Bloggs' },
                                    title => 'Some CD',
@@ -105,10 +103,13 @@ CREATE_RELATED2 :{
 			}
 		],
 
+    liner_notes => { notes => 'I can haz liner notes?' },
+
 	});
 	
 	ok( $cd_result && ref $cd_result eq 'DBICTest::CD', "Got Good CD Class");
 	ok( $cd_result->title eq "TestOneCD2", "Got Expected Title");
+  ok( $cd_result->notes eq 'I can haz liner notes?', 'Liner notes');
 	
 	my $tracks = $cd_result->tracks;