Merge 'trunk' into 'subquery'

r5554@rkinyon-lt-osx (orig r5553):  matthewt | 2009-02-19 23:35:14 -0500
 r27748@agaton (orig r5409):  groditi | 2009-02-04 21:23:06 +0000
 adding failing test to make sure insert doesnt call set_column

r5555@rkinyon-lt-osx (orig r5554):  matthewt | 2009-02-19 23:35:19 -0500
 r27749@agaton (orig r5410):  groditi | 2009-02-04 22:19:45 +0000
 use store_column instead of set_column on insert

r5557@rkinyon-lt-osx (orig r5556):  matthewt | 2009-02-19 23:35:25 -0500
 r27750@agaton (orig r5411):  groditi | 2009-02-05 02:35:41 +0000
 adding regression test for source_name

r5558@rkinyon-lt-osx (orig r5557):  matthewt | 2009-02-19 23:35:35 -0500
 r27769@agaton (orig r5430):  ribasushi | 2009-02-09 09:37:34 +0000
 Remove bogus test:
 mst: r5411 is groditi testing a fixed bug.

r5559@rkinyon-lt-osx (orig r5558):  matthewt | 2009-02-19 23:36:11 -0500

r5560@rkinyon-lt-osx (orig r5559):  matthewt | 2009-02-19 23:36:18 -0500
 r27872@agaton (orig r5533):  matthewt | 2009-02-20 02:22:47 +0000
 add DBIC_MULTICREATE_DEBUG, fix one bug with column values not being transferred

r5561@rkinyon-lt-osx (orig r5560):  matthewt | 2009-02-19 23:36:45 -0500
 r27877@agaton (orig r5538):  robkinyon | 2009-02-20 03:18:05 +0000
 Fixed some tests so they're now passing (things like bad plans and pod-coverage)

diff --git a/Changes b/Changes
index 9d7887b..a068719 100644 (file)
--- a/Changes
+++ b/Changes
@@ -23,6 +23,7 @@ Revision history for DBIx::Class
         - PG array datatype supported with SQLA >= 1.50
         - insert should use store_column, not set_column to avoid marking
           clean just-stored values as dirty. New test for this (groditi)
+        - regression test for source_name (groditi)
 
 0.08099_05 2008-10-30 21:30:00 (UTC)
         - Rewritte of Storage::DBI::connect_info(), extended with an

diff --git a/Makefile.PL b/Makefile.PL
index 1a3466f..38a89db 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -26,6 +26,7 @@ requires 'Scope::Guard'              => 0.03;
 requires 'Path::Class'               => 0;
 requires 'List::Util'                => 1.19;
 requires 'Sub::Name'                 => 0.04;
+requires 'namespace::clean'          => 0.09;
 
 # Perl 5.8.0 doesn't have utf8::is_utf8()
 requires 'Encode'                    => 0 if ($] <= 5.008000);  

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index bc88091..89bc6ff 100644 (file)
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -1014,6 +1014,9 @@ sub reverse_relationship_info {
       $ret->{$otherrel} =  $otherrel_info;
     }
   }
+use Data::Dumper;
+#warn "return for reverse_relationship_info called on ".$self->name." for $rel:\n";
+#warn Dumper($ret);
   return $ret;
 }
 

diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index ba05001..abc34ab 100644 (file)
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -8,6 +8,13 @@ use Carp::Clan qw/^DBIx::Class/;
 use Scalar::Util ();
 use Scope::Guard;
 
+BEGIN {
+  *MULTICREATE_DEBUG =
+    $ENV{DBIC_MULTICREATE_DEBUG}
+      ? sub () { 1 }
+      : sub () { 0 };
+}
+
 __PACKAGE__->mk_group_accessors('simple' => qw/_source_handle/);
 
 =head1 NAME
@@ -145,24 +152,38 @@ sub new {
             $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
           }
 
-          $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
+          if ($rel_obj->in_storage) {
+            $new->set_from_related($key, $rel_obj);
+          } else {
+            $new->{_rel_in_storage} = 0;
+            MULTICREATE_DEBUG and warn "MC $new: uninserted $key $rel_obj\n";
+          }
 
-          $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
           $related->{$key} = $rel_obj;
           next;
         } elsif ($info && $info->{attrs}{accessor}
             && $info->{attrs}{accessor} eq 'multi'
             && ref $attrs->{$key} eq 'ARRAY') {
           my $others = delete $attrs->{$key};
-          foreach my $rel_obj (@$others) {
+          my $total = @$others;
+          my @objects;
+          foreach my $idx (0 .. $#$others) {
+            my $rel_obj = $others->[$idx];
             if(!Scalar::Util::blessed($rel_obj)) {
               $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
             }
 
-            $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
+            if ($rel_obj->in_storage) {
+              $new->set_from_related($key, $rel_obj);
+            } else {
+              $new->{_rel_in_storage} = 0;
+              MULTICREATE_DEBUG and
+                warn "MC $new: uninserted $key $rel_obj ($idx of $total)\n";
+            }
             $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
+            push(@objects, $rel_obj);
           }
-          $related->{$key} = $others;
+          $related->{$key} = \@objects;
           next;
         } elsif ($info && $info->{attrs}{accessor}
           && $info->{attrs}{accessor} eq 'filter')
@@ -172,7 +193,10 @@ sub new {
           if(!Scalar::Util::blessed($rel_obj)) {
             $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
           }
-          $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
+          unless ($rel_obj->in_storage) {
+            $new->{_rel_in_storage} = 0;
+            MULTICREATE_DEBUG and warn "MC $new: uninserted $key $rel_obj";
+          }
           $inflated->{$key} = $rel_obj;
           next;
         } elsif ($class->has_column($key)
@@ -256,12 +280,15 @@ sub insert {
                         $relname, { $rel_obj->get_columns }
                       );
 
+      MULTICREATE_DEBUG and warn "MC $self pre-inserting $relname $rel_obj\n";
+
       $rel_obj->insert();
       $self->set_from_related($relname, $rel_obj);
       delete $related_stuff{$relname};
     }
   }
 
+  MULTICREATE_DEBUG and warn "MC $self inserting self\n";
   my $updated_cols = $source->storage->insert($source, { $self->get_columns });
   foreach my $col (keys %$updated_cols) {
     $self->store_column($col, $updated_cols->{$col});
@@ -276,7 +303,7 @@ sub insert {
   if (@auto_pri) {
     #$self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
     #  if defined $too_many;
-
+    MULTICREATE_DEBUG and warn "MC $self fetching missing PKs ".join(', ', @auto_pri)."\n";
     my $storage = $self->result_source->storage;
     $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
       unless $storage->can('last_insert_id');
@@ -284,8 +311,10 @@ sub insert {
     $self->throw_exception( "Can't get last insert id" )
       unless (@ids == @auto_pri);
     $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
+#use Data::Dumper; warn Dumper($self);
   }
 
+
   $self->{_dirty_columns} = {};
   $self->{related_resultsets} = {};
 
@@ -306,8 +335,12 @@ sub insert {
           $obj->set_from_related($_, $self) for keys %$reverse;
           my $them = { %{$obj->{_relationship_data} || {} }, $obj->get_inflated_columns };
           if ($self->__their_pk_needs_us($relname, $them)) {
-            $obj = $self->find_or_create_related($relname, $them);
+            MULTICREATE_DEBUG and warn "MC $self re-creating $relname $obj";
+            my $re = $self->find_or_create_related($relname, $them);
+            $obj->{_column_data} = $re->{_column_data};
+            MULTICREATE_DEBUG and warn "MC $self new $relname $obj";
           } else {
+            MULTICREATE_DEBUG and warn "MC $self post-inserting $obj";
             $obj->insert();
           }
         }

diff --git a/t/03podcoverage.t b/t/03podcoverage.t
index e3059a1..18c5292 100644 (file)
--- a/t/03podcoverage.t
+++ b/t/03podcoverage.t
@@ -29,6 +29,11 @@ my $exceptions = {
               mk_classaccessor/
         ]
     },
+    'DBIx::Class::Row' => {
+        ignore => [
+           qw( MULTICREATE_DEBUG )
+        ],
+    },
     'DBIx::Class::Storage' => {
         ignore => [
             qw(cursor)

diff --git a/t/66relationship.t b/t/66relationship.t
index 88f5c16..0ae02e6 100644 (file)
--- a/t/66relationship.t
+++ b/t/66relationship.t
@@ -8,7 +8,7 @@ use DBICTest;
 
 my $schema = DBICTest->init_schema();
 
-plan tests => 75;
+plan tests => 69;
 
 # has_a test
 my $cd = $schema->resultset("CD")->find(4);