Merge 'DBIx-Class-current' into 'bulk_create'
Jess Robinson [Fri, 18 May 2007 12:24:00 +0000 (12:24 +0000)]
r3302@lilith (orig r3300):  matthewt | 2007-05-11 04:54:27 +0100
eliminate the last of the AutoCommit warnings
r3304@lilith (orig r3302):  matthewt | 2007-05-11 13:38:18 +0100
fixup for Oracle WHERE join stuff from abraxxa
r3310@lilith (orig r3308):  claco | 2007-05-12 02:31:37 +0100
Require CAG 0.05002 to kill Class::Inspector warnings.

r3317@lilith (orig r3315):  blblack | 2007-05-14 23:59:07 +0100
default AutoCommit to 1 if not explicitly set, and stop warning about it

lib/DBIx/Class/Relationship/Base.pm
lib/DBIx/Class/ResultSet.pm
lib/DBIx/Class/ResultSource.pm
lib/DBIx/Class/Row.pm
t/101populate_rs.t [new file with mode: 0644]
t/96file_column.t
t/96multi_create.t [new file with mode: 0644]

index f31e685..1fbcf52 100644 (file)
@@ -324,12 +324,16 @@ sub update_or_create_related {
 =head2 set_from_related
 
   $book->set_from_related('author', $author_obj);
+  $book->author($author_obj);                      ## same thing
 
 Set column values on the current object, using related values from the given
 related object. This is used to associate previously separate objects, for
 example, to set the correct author for a book, find the Author object, then
 call set_from_related on the book.
 
+This is called internally when you pass existing objects as values to
+L<DBIx::Class::ResultSet/create>, or pass an object to a belongs_to acessor.
+
 The columns are only set in the local copy of the object, call L</update> to
 set them in the storage.
 
index 39ca196..f49a071 100644 (file)
@@ -350,11 +350,13 @@ sub find {
 
   my (%related, $info);
 
-  foreach my $key (keys %$input_query) {
+  KEY: foreach my $key (keys %$input_query) {
     if (ref($input_query->{$key})
         && ($info = $self->result_source->relationship_info($key))) {
+      my $val = delete $input_query->{$key};
+      next KEY if (ref($val) eq 'ARRAY'); # has_many for multi_create
       my $rel_q = $self->result_source->resolve_condition(
-                    $info->{cond}, delete $input_query->{$key}, $key
+                    $info->{cond}, $val, $key
                   );
       die "Can't handle OR join condition in find" if ref($rel_q) eq 'ARRAY';
       @related{keys %$rel_q} = values %$rel_q;
@@ -1238,6 +1240,99 @@ sub delete_all {
   return 1;
 }
 
+=head2 populate
+
+=over 4
+
+=item Arguments: $source_name, \@data;
+
+=back
+
+Pass an arrayref of hashrefs. Each hashref should be a structure suitable for
+submitting to a $resultset->create(...) method.
+
+In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
+to insert the data, as this is a fast method.
+
+Otherwise, each set of data is inserted into the database using
+L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
+objects is returned.
+
+i.e.,
+
+  $rs->populate( [
+         { artistid => 4, name => 'Manufactured Crap', cds => [ 
+                 { title => 'My First CD', year => 2006 },
+                 { title => 'Yet More Tweeny-Pop crap', year => 2007 },
+               ] 
+         },
+         { artistid => 5, name => 'Angsty-Whiny Girl', cds => [
+                 { title => 'My parents sold me to a record company' ,year => 2005 },
+                 { title => 'Why Am I So Ugly?', year => 2006 },
+                 { title => 'I Got Surgery and am now Popular', year => 2007 }
+               ]
+         },
+         { name => 'Like I Give a Damn' }
+
+       ] );
+
+=cut
+use Data::Dump qw/dump/;
+
+sub populate {
+  my ($self, $data) = @_;
+  
+  if(defined wantarray) {
+    my @created;
+    foreach my $item (@$data) {
+      push(@created, $self->create($item));
+    }
+    return @created;
+  } else {
+    my ($first, @rest) = @$data;
+       
+    my @names = grep { !ref $first->{$_} } keys %$first;
+       
+       my @values = map {
+               [ map {
+                       defined $_ ? $_ : $self->throw_exception("Undefined value for column!")
+               } @$_{@names} ]
+       } @$data;
+               
+    $self->result_source->storage->insert_bulk(
+               $self->result_source, 
+               \@names, 
+               \@values,
+       );
+
+       my @rels = grep { $self->result_source->has_relationship($_) } keys %$first;
+       my @pks = $self->result_source->primary_columns;
+
+       foreach my $item (@$data) {
+
+               foreach my $rel (@rels) {
+                       next unless $item->{$rel};
+                       
+                       my $parent      = $self->find(map {{$_=>$item->{$_}} } @pks) || next;
+                       my $child       = $parent->$rel;
+
+                       my $related = $child->result_source->resolve_condition(
+                               
+                               $parent->result_source->relationship_info($rel)->{cond},
+                               $child,
+                               $parent,
+                       );
+                       
+                       my @rows_to_add = ref $item->{$rel} eq 'ARRAY' ? @{$item->{$rel}} : ($item->{$rel});
+                       my @populate = map { {%$_, %$related} } @rows_to_add;
+
+                       $child->populate( \@populate );
+               }
+       }
+       
+  }
+}
+
 =head2 pager
 
 =over 4
index e4d30e9..9a2e061 100644 (file)
@@ -771,6 +771,8 @@ sub resolve_condition {
         #warn %ret;
       } elsif (!defined $for) { # undef, i.e. "no object"
         $ret{$k} = undef;
+      } elsif (ref $as eq 'HASH') { # reverse hashref
+        $ret{$v} = $as->{$k};
       } elsif (ref $as) { # reverse object
         $ret{$v} = $as->get_column($k);
       } elsif (!defined $as) { # undef, i.e. "no reverse object"
index 66c6cfb..f4d33cb 100644 (file)
@@ -5,6 +5,7 @@ use warnings;
 
 use base qw/DBIx::Class/;
 use Carp::Clan qw/^DBIx::Class/;
+use Scalar::Util ();
 
 __PACKAGE__->mk_group_accessors('simple' => qw/_source_handle/);
 
@@ -27,8 +28,21 @@ derived from L<DBIx::Class::ResultSource> objects.
 
 Creates a new row object from column => value mappings passed as a hash ref
 
+Passing an object, or an arrayref of objects as a value will call
+L<DBIx::Class::Relationship::Base/set_from_related> for you. When
+passed a hashref or an arrayref of hashrefs as the value, these will
+be turned into objects via new_related, and treated as if you had
+passed objects.
+
 =cut
 
+## It needs to store the new objects somewhere, and call insert on that list later when insert is called on this object. We may need an accessor for these so the user can retrieve them, if just doing ->new().
+## This only works because DBIC doesnt yet care to check whether the new_related objects have been passed all their mandatory columns
+## When doing the later insert, we need to make sure the PKs are set.
+## using _relationship_data in new and funky ways..
+## check Relationship::CascadeActions and Relationship::Accessor for compat
+## tests!
+
 sub new {
   my ($class, $attrs) = @_;
   $class = ref $class if ref $class;
@@ -48,23 +62,54 @@ sub new {
       unless ref($attrs) eq 'HASH';
     
     my ($related,$inflated);
+    ## Pretend all the rels are actual objects, unset below if not, for insert() to fix
+    $new->{_rel_in_storage} = 1;
+
     foreach my $key (keys %$attrs) {
       if (ref $attrs->{$key}) {
+        ## Can we extract this lot to use with update(_or .. ) ?
         my $info = $class->relationship_info($key);
         if ($info && $info->{attrs}{accessor}
           && $info->{attrs}{accessor} eq 'single')
         {
-          $new->set_from_related($key, $attrs->{$key});        
-          $related->{$key} = $attrs->{$key};
+          my $rel_obj = delete $attrs->{$key};
+          if(!Scalar::Util::blessed($rel_obj)) {
+            $rel_obj = $new->find_or_new_related($key, $rel_obj);
+            $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
+          }
+          $new->set_from_related($key, $rel_obj);        
+          $related->{$key} = $rel_obj;
           next;
-        }
-        elsif ($class->has_column($key)
-          && exists $class->column_info($key)->{_inflate_info})
+        } 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) {
+            if(!Scalar::Util::blessed($rel_obj)) {
+              $rel_obj = $new->new_related($key, $rel_obj);
+              $new->{_rel_in_storage} = 0;
+            }
+          }
+          $related->{$key} = $others;
+          next;
+        } elsif ($info && $info->{attrs}{accessor}
+          && $info->{attrs}{accessor} eq 'filter')
         {
+          ## 'filter' should disappear and get merged in with 'single' above!
+          my $rel_obj = delete $attrs->{$key};
+          if(!Scalar::Util::blessed($rel_obj)) {
+            $rel_obj = $new->find_or_new_related($key, $rel_obj);
+            $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
+          }
+          $inflated->{$key} = $rel_obj;
+          next;
+        } elsif ($class->has_column($key)
+            && $class->column_info($key)->{_inflate_info}) {
           $inflated->{$key} = $attrs->{$key};
           next;
         }
       }
+      use Data::Dumper;
       $new->throw_exception("No such column $key on $class")
         unless $class->has_column($key);
       $new->store_column($key => $attrs->{$key});          
@@ -98,7 +143,60 @@ sub insert {
   $self->throw_exception("No result_source set on this object; can't insert")
     unless $source;
 
+  # 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;
+
+    ## 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 $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);
+      }
+    }
+  }
+
   $source->storage->insert($source, { $self->get_columns });
+
+  ## PK::Auto
+  my ($pri, $too_many) = grep { !defined $self->get_column($_) || 
+                                    ref($self->get_column($_)) eq 'SCALAR'} $self->primary_columns;
+  if(defined $pri) {
+    $self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
+      if defined $too_many;
+
+    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');
+    my $id = $storage->last_insert_id($self->result_source,$pri);
+    $self->throw_exception( "Can't get last insert id" ) unless $id;
+    $self->store_column($pri => $id);
+  }
+
+  if(!$self->{_rel_in_storage})
+  {
+    ## 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);
+          $obj->insert() if(!$obj->in_storage);
+        }
+      }
+    }
+    $source->storage->txn_commit;
+  }
+
   $self->in_storage(1);
   $self->{_dirty_columns} = {};
   $self->{related_resultsets} = {};
@@ -152,7 +250,19 @@ sub update {
           my $rel = delete $upd->{$key};
           $self->set_from_related($key => $rel);
           $self->{_relationship_data}{$key} = $rel;          
-        } 
+        } elsif ($info && $info->{attrs}{accessor}
+            && $info->{attrs}{accessor} eq 'multi'
+            && ref $upd->{$key} eq 'ARRAY') {
+            my $others = delete $upd->{$key};
+            foreach my $rel_obj (@$others) {
+              if(!Scalar::Util::blessed($rel_obj)) {
+                $rel_obj = $self->create_related($key, $rel_obj);
+              }
+            }
+            $self->{_relationship_data}{$key} = $others; 
+#            $related->{$key} = $others;
+            next;
+        }
         elsif ($self->has_column($key)
           && exists $self->column_info($key)->{_inflate_info})
         {
diff --git a/t/101populate_rs.t b/t/101populate_rs.t
new file mode 100644 (file)
index 0000000..c4c8830
--- /dev/null
@@ -0,0 +1,115 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+plan tests => 31;
+
+my $schema = DBICTest->init_schema();
+my $rs = $schema->resultset('Artist');
+
+RETURN_RESULTSETS: {
+
+       my ($crap, $girl, $damn, $xxxaaa) = $rs->populate( [
+         { artistid => 4, name => 'Manufactured Crap', cds => [ 
+                 { title => 'My First CD', year => 2006 },
+                 { title => 'Yet More Tweeny-Pop crap', year => 2007 },
+               ] 
+         },
+         { artistid => 5, name => 'Angsty-Whiny Girl', cds => [
+                 { title => 'My parents sold me to a record company' ,year => 2005 },
+                 { title => 'Why Am I So Ugly?', year => 2006 },
+                 { title => 'I Got Surgery and am now Popular', year => 2007 }
+
+               ]
+         },
+         { artistid=>6, name => 'Like I Give a Damn' },
+         
+         { artistid => 7, name => 'bbbb', cds => [
+                 { title => 'xxxaaa' ,year => 2005 },
+               ]
+         },
+
+       ] );
+       
+       isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
+       isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
+       isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");     
+       isa_ok( $xxxaaa, 'DBICTest::Artist', "Got 'Artist'");   
+       
+       ok( $crap->name eq 'Manufactured Crap', "Got Correct name for result object");
+       ok( $girl->name eq 'Angsty-Whiny Girl', "Got Correct name for result object");
+       ok( $xxxaaa->name eq 'bbbb', "Got Correct name for result object");
+       
+       use Data::Dump qw/dump/;
+       
+       ok( $crap->cds->count == 2, "got Expected Number of Cds");
+       ok( $girl->cds->count == 3, "got Expected Number of Cds");
+}
+
+RETURN_VOID: {
+
+       $rs->populate( [
+         { artistid => 8, name => 'Manufactured CrapB', cds => [ 
+                 { title => 'My First CDB', year => 2006 },
+                 { title => 'Yet More Tweeny-Pop crapB', year => 2007 },
+               ] 
+         },
+         { artistid => 9, name => 'Angsty-Whiny GirlB', cds => [
+                 { title => 'My parents sold me to a record companyB' ,year => 2005 },
+                 { title => 'Why Am I So Ugly?B', year => 2006 },
+                 { title => 'I Got Surgery and am now PopularB', year => 2007 }
+
+               ]
+         },
+         { artistid =>10,  name => 'XXXX' },
+         { artistid =>11, name => 'wart', cds =>{ title => 'xxxaaa' ,year => 2005 }, },
+       ] );
+       
+       my $artist = $rs->find(8);
+
+       ok($artist, 'Found artist');
+       is($artist->name, 'Manufactured CrapB', "Got Correct Name");
+       is($artist->cds->count, 2, 'Has CDs');
+
+       my @cds = $artist->cds;
+
+       is($cds[0]->title, 'My First CDB', 'A CD');
+       is($cds[0]->year,  2006, 'Published in 2006');
+
+       is($cds[1]->title, 'Yet More Tweeny-Pop crapB', 'Another crap CD');
+       is($cds[1]->year,  2007, 'Published in 2007');
+
+       $artist = $rs->find(9);
+       ok($artist, 'Found artist');
+       is($artist->name, 'Angsty-Whiny GirlB', "Another correct name");
+       is($artist->cds->count, 3, 'Has CDs');
+       
+       @cds = $artist->cds;
+
+
+       is($cds[0]->title, 'My parents sold me to a record companyB', 'A CD');
+       is($cds[0]->year,  2005, 'Published in 2005');
+
+       is($cds[1]->title, 'Why Am I So Ugly?B', 'A Coaster');
+       is($cds[1]->year,  2006, 'Published in 2006');
+
+       is($cds[2]->title, 'I Got Surgery and am now PopularB', 'Selling un-attainable dreams');
+       is($cds[2]->year,  2007, 'Published in 2007');
+
+       $artist = $rs->search({name => 'XXXX'})->single;
+       ok($artist, "Got Expected Artist Result");
+
+       is($artist->cds->count, 0, 'No CDs');
+       
+       $artist = $rs->find(10);
+       is($artist->name, 'XXXX', "Got Correct Name");
+       is($artist->cds->count, 0, 'Has NO CDs');
+       
+       $artist = $rs->find(11);
+       is($artist->name, 'wart', "Got Correct Name");
+       is($artist->cds->count, 1, 'Has One CD');
+}
+
index 4773861..d32e373 100644 (file)
@@ -12,4 +12,4 @@ plan tests => 1;
 
 my $fh = new IO::File('t/96file_column.t','r');
 eval { $schema->resultset('FileColumn')->create({file => {handle => $fh, filename =>'96file_column.t'}})};
-ok(!$@,'FileColumn checking if file handled properly.');
+cmp_ok($@,'eq','','FileColumn checking if file handled properly.');
diff --git a/t/96multi_create.t b/t/96multi_create.t
new file mode 100644 (file)
index 0000000..ac5f219
--- /dev/null
@@ -0,0 +1,122 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DateTime;
+
+my $schema = DBICTest->init_schema();
+
+plan tests => 17;
+
+my $cd2 = $schema->resultset('CD')->create({ artist => 
+                                   { name => 'Fred Bloggs' },
+                                   title => 'Some CD',
+                                   year => 1996
+                                 });
+
+is(ref $cd2->artist, 'DBICTest::Artist', 'Created CD and Artist object');
+is($cd2->artist->name, 'Fred Bloggs', 'Artist created correctly');
+
+my $artist = $schema->resultset('Artist')->create({ name => 'Fred 2',
+                                                     cds => [
+                                                             { title => 'Music to code by',
+                                                               year => 2007,
+                                                             },
+                                                             ],
+                                                     });
+is(ref $artist->cds->first, 'DBICTest::CD', 'Created Artist with CDs');
+is($artist->cds->first->title, 'Music to code by', 'CD created correctly');
+
+# Add a new CD
+$artist->update({cds => [ $artist->cds, 
+                          { title => 'Yet another CD',
+                            year => 2006,
+                          },
+                        ],
+                });
+is(($artist->cds->search({}, { order_by => 'year' }))[0]->title, 'Yet another CD', 'Updated and added another CD');
+
+my $newartist = $schema->resultset('Artist')->find_or_create({ name => 'Fred 2'});
+
+is($newartist->name, 'Fred 2', 'Retrieved the artist');
+
+
+my $newartist2 = $schema->resultset('Artist')->find_or_create({ name => 'Fred 3',
+                                                                cds => [
+                                                                        { title => 'Noah Act',
+                                                                          year => 2007,
+                                                                        },
+                                                                       ],
+
+                                                              });
+
+is($newartist2->name, 'Fred 3', 'Created new artist with cds via find_or_create');
+
+
+CREATE_RELATED1 :{
+
+       my $artist = $schema->resultset('Artist')->first;
+       
+       my $cd_result = $artist->create_related('cds', {
+       
+               title => 'TestOneCD1',
+               year => 2007,
+               tracks => [
+               
+                       { position=>111,
+                         title => 'TrackOne',
+                       },
+                       { position=>112,
+                         title => 'TrackTwo',
+                       }
+               ],
+
+       });
+       
+       ok( $cd_result && ref $cd_result eq 'DBICTest::CD', "Got Good CD Class");
+       ok( $cd_result->title eq "TestOneCD1", "Got Expected Title");
+       
+       my $tracks = $cd_result->tracks;
+       
+       ok( ref $tracks eq "DBIx::Class::ResultSet", "Got Expected Tracks ResultSet");
+       
+       foreach my $track ($tracks->all)
+       {
+               ok( $track && ref $track eq 'DBICTest::Track', 'Got Expected Track Class');
+       }
+}
+
+CREATE_RELATED2 :{
+
+       my $artist = $schema->resultset('Artist')->first;
+       
+       my $cd_result = $artist->create_related('cds', {
+       
+               title => 'TestOneCD2',
+               year => 2007,
+               tracks => [
+               
+                       { position=>111,
+                         title => 'TrackOne',
+                       },
+                       { position=>112,
+                         title => 'TrackTwo',
+                       }
+               ],
+
+       });
+       
+       ok( $cd_result && ref $cd_result eq 'DBICTest::CD', "Got Good CD Class");
+       ok( $cd_result->title eq "TestOneCD2", "Got Expected Title");
+       
+       my $tracks = $cd_result->tracks;
+       
+       ok( ref $tracks eq "DBIx::Class::ResultSet", "Got Expected Tracks ResultSet");
+       
+       foreach my $track ($tracks->all)
+       {
+               ok( $track && ref $track eq 'DBICTest::Track', 'Got Expected Track Class');
+       }
+}