[Bast-commits] r3517 - in trunk/DBIx-Class: . lib/DBIx/Class t

[matthewt at dev.catalyst.perl.org]

Author: matthewt
Date: 2007-06-20 05:14:52 +0100 (Wed, 20 Jun 2007)
New Revision: 3517

Modified:
   trunk/DBIx-Class/Changes
   trunk/DBIx-Class/Makefile.PL
   trunk/DBIx-Class/lib/DBIx/Class/Row.pm
   trunk/DBIx-Class/t/96multi_create.t
Log:
probably fix bulk_create

Modified: trunk/DBIx-Class/Changes
===================================================================
--- trunk/DBIx-Class/Changes	2007-06-20 04:00:54 UTC (rev 3516)
+++ trunk/DBIx-Class/Changes	2007-06-20 04:14:52 UTC (rev 3517)
@@ -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

Modified: trunk/DBIx-Class/Makefile.PL
===================================================================
--- trunk/DBIx-Class/Makefile.PL	2007-06-20 04:00:54 UTC (rev 3516)
+++ trunk/DBIx-Class/Makefile.PL	2007-06-20 04:14:52 UTC (rev 3517)
@@ -17,6 +17,7 @@
 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);  

Modified: trunk/DBIx-Class/lib/DBIx/Class/Row.pm
===================================================================
--- trunk/DBIx-Class/lib/DBIx/Class/Row.pm	2007-06-20 04:00:54 UTC (rev 3516)
+++ trunk/DBIx-Class/lib/DBIx/Class/Row.pm	2007-06-20 04:14:52 UTC (rev 3517)
@@ -6,6 +6,7 @@
 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 @@
   $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 @@
   {
     ## 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);

Modified: trunk/DBIx-Class/t/96multi_create.t
===================================================================
--- trunk/DBIx-Class/t/96multi_create.t	2007-06-20 04:00:54 UTC (rev 3516)
+++ trunk/DBIx-Class/t/96multi_create.t	2007-06-20 04:14:52 UTC (rev 3517)
@@ -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 @@
 			}
 		],
 
+    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;