use base qw/DBIx::Class/;
use Carp::Clan qw/^DBIx::Class/;
+use Scalar::Util ();
__PACKAGE__->mk_group_accessors('simple' => qw/_source_handle/);
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;
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;
+ print STDERR "Attrs: ", Dumper($attrs), "\n";
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};
+ print STDERR "REL: $key ", ref($rel_obj), "\n";
+ if(!Scalar::Util::blessed($rel_obj)) {
+ $rel_obj = $new->new_related($key, $rel_obj);
+ print STDERR "REL: $key ", ref($rel_obj), "\n";
+ $new->{_rel_in_storage} = 0;
+ }
+ $new->set_from_related($key, $rel_obj);
+ $related->{$key} = $rel_obj;
next;
- }
- elsif ($class->has_column($key)
+ } 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 ($class->has_column($key)
&& exists $class->column_info($key)->{_inflate_info})
{
- $inflated->{$key} = $attrs->{$key};
+ ## 'filter' should disappear and get merged in with 'single' above!
+ my $rel_obj = $attrs->{$key};
+ if(!Scalar::Util::blessed($rel_obj)) {
+ $rel_obj = $new->new_related($key, $rel_obj);
+ $new->{_rel_in_storage} = 0;
+ }
+ $inflated->{$key} = $rel_obj;
next;
}
}
+ use Data::Dumper;
+ print STDERR "Key: ", Dumper($key), "\n";
$new->throw_exception("No such column $key on $class")
unless $class->has_column($key);
$new->store_column($key => $attrs->{$key});
$self->throw_exception("No result_source set on this object; can't insert")
unless $source;
+ # Check if we stored uninserted relobjs here in new()
+ $source->storage->txn_begin if(!$self->{_rel_in_storage});
+
+ my %related_stuff = (%{$self->{_relationship_data} || {}},
+ %{$self->{_inflated_column} || {}});
+ ## 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 $relobj = $related_stuff{$relname};
+ if(ref $relobj ne 'ARRAY') {
+ $relobj->insert() if(!$relobj->in_storage);
+ print STDERR "Inserting: ", ref($relobj), "\n";
+ $self->set_from_related($relname, $relobj);
+ }
+ }
+
$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);
+ }
+
+ ## 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+)/);
+ print STDERR "Inserting: ", ref($obj), "\n";
+ $obj->set_from_related($key, $self);
+ $obj->insert() if(!$obj->in_storage);
+ }
+ }
+ }
+ $source->storage->txn_commit if(!$self->{_rel_in_storage});
+
$self->in_storage(1);
$self->{_dirty_columns} = {};
$self->{related_resultsets} = {};
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})
{
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+plan tests => 6;
+
+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');
projects / dbsrgits/DBIx-Class.git / commitdiff