account for coderefs partially

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index d0e5006..fcbbcc1 100644 (file)
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -2241,6 +2241,7 @@ sub populate {
     my $data = $self->_normalize_populate_to_arrayref(@_);
 
     return unless @$data;
+    use DDP; p $data;
 
     my $first = shift @$data;
 
@@ -2249,14 +2250,20 @@ sub populate {
     my (@rels, @columns);
     my $rsrc = $self->result_source;
     my $rels = { map { $_ => $rsrc->relationship_info($_) } $rsrc->relationships };
-    for my $index (0..$#$first) {
-      my $col = $first->[$index];
-      my $val = $data->[0][$index];
-      my $ref = ref $val;
-      $rels->{$col} && ($ref eq 'ARRAY' or $ref eq 'HASH')
-        ? push @rels, $col
-        : push @columns, $col
-      ;
+
+    if (ref $data->[0] eq 'CODE') {
+      @columns = @$first;
+    }
+    else {
+      for my $index (0..$#$first) {
+        my $col = $first->[$index];
+        my $val = $data->[0][$index];
+        my $ref = ref $val;
+        $rels->{$col} && ($ref eq 'ARRAY' or $ref eq 'HASH')
+          ? push @rels, $col
+          : push @columns, $col
+        ;
+      }
     }
 
     my @pks = $rsrc->primary_columns;
@@ -2264,6 +2271,7 @@ sub populate {
 
     ## do the belongs_to relationships
     foreach my $index (0..$#$data) {
+      next if (ref $data->[$index] eq 'CODE');
 
       # delegate to list context populate()/create() for any dataset without
       # primary keys with specified relationships
@@ -2313,6 +2321,7 @@ sub populate {
 
     ## do the has_many relationships
     foreach my $item (@$data) {
+      next if (ref $item eq  'CODE');
 
       my $main_row;
 

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 219bd4c..d754a59 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1964,6 +1964,7 @@ sub insert {
 sub insert_bulk {
   my ($self, $source, $cols, $data) = @_;
 
+  use DDP; p $data;
   my @col_range = (0..$#$cols);
 
   # FIXME SUBOPTIMAL - most likely this is not necessary at all
@@ -1971,7 +1972,6 @@ sub insert_bulk {
   #
   # forcibly stringify whatever is stringifiable
   # ResultSet::populate() hands us a copy - safe to mangle
-  # Check with Riba: is this still dangerous?
   for my $r (0 .. $#$data) {
     for my $c (0 .. $#{$data->[$r]}) {
       $data->[$r][$c] = "$data->[$r][$c]"

diff --git a/t/100populate.t b/t/100populate.t
index 94a9737..d0427f1 100644 (file)
--- a/t/100populate.t
+++ b/t/100populate.t
@@ -445,19 +445,37 @@ lives_ok ( sub {
   ])
 }, 'empty has_many relationship accepted by populate');
 
-done_testing;
+lives_ok ( sub {
+  my $genre_max = $schema->resultset('Genre')->get_column('genreid')->max;
+  $schema->populate('CD', [
+    {cdid => 10002, artist => $artist->id, title => 'Pretty Much Foo', year => 2011, genre => { name => 'country' } }
+  ]);
+
+  is_deeply($schema->resultset('Genre')->search({ name => 'country' })->all_hri,
+    [{ genreid => $genre_max + 1, name => 'country' }],
+    "Populate() belongs_to inserts in void context"
+  );
+}, 'void context belongs_to rels are populated');
+
+#my $q = $schema->resultset('CD')->search({}, { columns => [qw/artist year/], group_by => 'artist' })->as_query;
+#$schema->storage->insert_bulk($artist_src, [qw/name rank/], [[[qw/foo 1/], [qw/baz 2/]],  $q, [[qw/asdf 5/], [qw/uhiuh 6/]]]);
+#my @cols = $artist_src->columns;
 
 my $artist_rs = $schema->resultset('Artist');
 my $artist_src = $artist_rs->result_source;
 
-my $q = $schema->resultset('CD')->search({}, { columns => [qw/artist year/], group_by => 'artist' })->as_query;
+#use DDP::S; scope {
 my $count = 0;
 my $name = "zaaaaa";
+$artist_rs->populate([
+  [qw/artistid name/],
+  [109, 'some crap'],
+  [110, 'some crap'],
+  sub {
+    return [$name++, ++$count] unless $count > 5;
+    return undef;
+  },
+]);
+#};
 
-#$schema->storage->insert_bulk($artist_src, [qw/name rank/], [[[qw/foo 1/], [qw/baz 2/]], sub {
-#  return [$name++, ++$count] unless $count > 5;
-#  return undef;
-#}, $q, [[qw/asdf 5/], [qw/uhiuh 6/]]]);
-
-my @cols = $artist_src->columns;
-$rs->populate(\@cols, $rs->search(undef)->as_query )
+done_testing;