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/);
if $self->can('result_source_instance');
$self->throw_exception("No result_source set on this object; can't insert")
unless $source;
- #use Data::Dumper; warn Dumper($self);
- # Check if we stored uninserted relobjs here in new()
- $source->storage->txn_begin if(!$self->{_rel_in_storage});
+
+ 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})
- {
+
+ 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 $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);
+
+ next REL unless (Scalar::Util::blessed($rel_obj)
+ && $rel_obj->isa('DBIx::Class::Row'));
+
+ my $cond = $source->relationship_info($relname)->{cond};
+
+ next REL unless ref($cond) eq 'HASH';
+
+ # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
+
+ my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
+
+ # assume anything that references our PK probably is dependent on us
+ # rather than vice versa, unless the far side is (a) defined or (b)
+ # auto-increment
+
+ foreach my $p (@pri) {
+ if (exists $keyhash->{$p}) {
+ warn $keyhash->{$p};
+ unless (defined($rel_obj->get_column($keyhash->{$p}))
+ || $rel_obj->column_info($keyhash->{$p})
+ ->{is_auto_increment}) {
+ next REL;
+ }
+ }
}
+
+ $rel_obj->insert();
+ $self->set_from_related($relname, $rel_obj);
+ delete $related_stuff{$relname};
}
}
$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 @auto_pri = grep {
+ !defined $self->get_column($_) ||
+ ref($self->get_column($_)) eq 'SCALAR'
+ } $self->primary_columns;
+
+ if (@auto_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);
+ my @ids = $storage->last_insert_id($self->result_source,@auto_pri);
+ $self->throw_exception( "Can't get last insert id" )
+ unless (@ids == @auto_pri);
+ $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
}
- if(!$self->{_rel_in_storage})
- {
+ 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);
+ 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);
Also takes an options hashref of C<< column_name => value> pairs >> to update
first. But be aware that this hashref might be edited in place, so dont rely on
-it being the same after a call to C<update>.
+it being the same after a call to C<update>. If you need to preserve the hashref,
+it is sufficient to pass a shallow copy to C<update>, e.g. ( { %{ $href } } )
=cut
sub throw_exception {
my $self=shift;
- if (ref $self && ref $self->result_source) {
+ if (ref $self && ref $self->result_source && $self->result_source->schema) {
$self->result_source->schema->throw_exception(@_);
} else {
croak(@_);