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/);
be turned into objects via new_related, and treated as if you had
passed objects.
+For a more involved explanation, see L<DBIx::Class::ResultSet/create>.
+
=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().
my ($class, $attrs) = @_;
$class = ref $class if ref $class;
- my $new = { _column_data => {} };
+ my $new = {
+ _column_data => {},
+ };
bless $new, $class;
if (my $handle = delete $attrs->{-source_handle}) {
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->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
+
$new->set_from_related($key, $rel_obj);
$related->{$key} = $rel_obj;
next;
$rel_obj = $new->new_related($key, $rel_obj);
$new->{_rel_in_storage} = 0;
}
+
+ $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
}
$related->{$key} = $others;
next;
next;
}
}
- use Data::Dumper;
$new->throw_exception("No such column $key on $class")
unless $class->has_column($key);
$new->store_column($key => $attrs->{$key});
an entirely new object into the database, use C<create> (see
L<DBIx::Class::ResultSet/create>).
+This will also insert any uninserted, related objects held inside this
+one, see L<DBIx::Class::ResultSet/create> for more details.
+
=cut
sub insert {
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}) {
+ 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);
- $obj->insert() if(!$obj->in_storage);
+ 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() unless ($obj->in_storage || $obj->result_source->resultset->search({$obj->get_columns})->count);
}
}
}
$source->storage->txn_commit;
+ $rollback_guard->dismiss;
}
$self->in_storage(1);
$obj->in_storage; # Get value
$obj->in_storage(1); # Set value
-Indicated whether the object exists as a row in the database or not
+Indicates whether the object exists as a row in the database or not
=cut
required.
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>.
+first. But be awawre that the hashref will be passed to
+C<set_inflated_columns>, which might edit it in place, so dont rely on 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
$self->throw_exception("Cannot safely update a row in a PK-less table")
if ! keys %$ident_cond;
- if ($upd) {
- foreach my $key (keys %$upd) {
- if (ref $upd->{$key}) {
- my $info = $self->relationship_info($key);
- if ($info && $info->{attrs}{accessor}
- && $info->{attrs}{accessor} eq 'single')
- {
- 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})
- {
- $self->set_inflated_column($key, delete $upd->{$key});
- }
- }
- }
- $self->set_columns($upd);
- }
+ $self->set_inflated_columns($upd) if $upd;
my %to_update = $self->get_dirty_columns;
return $self unless keys %to_update;
my $rows = $self->result_source->storage->update(
reinserted using C<< ->insert() >> before C<< ->update() >> can be used
on it. If you delete an object in a class with a C<has_many>
relationship, all the related objects will be deleted as well. To turn
-this behavior off, pass C<cascade_delete => 0> in the C<$attr>
+this behavior off, pass C<< cascade_delete => 0 >> in the C<$attr>
hashref. Any database-level cascade or restrict will take precedence
over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
my $old = $self->get_column($column);
my $ret = $self->store_column(@_);
$self->{_dirty_columns}{$column} = 1
- if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
+ if (defined $old xor defined $ret) || (defined $old && $old ne $ret);
+
+ # XXX clear out the relation cache for this column
+ delete $self->{related_resultsets}{$column};
+
return $ret;
}
return $self;
}
+=head2 set_inflated_columns
+
+ my $copy = $orig->set_inflated_columns({ $col => $val, $rel => $obj, ... });
+
+Sets more than one column value at once, taking care to respect inflations and
+relationships if relevant. Be aware that this hashref might be edited in place,
+so dont rely on it being the same after a call to C<set_inflated_columns>. If
+you need to preserve the hashref, it is sufficient to pass a shallow copy to
+C<set_inflated_columns>, e.g. ( { %{ $href } } )
+
+=cut
+
+sub set_inflated_columns {
+ my ( $self, $upd ) = @_;
+ foreach my $key (keys %$upd) {
+ if (ref $upd->{$key}) {
+ my $info = $self->relationship_info($key);
+ if ($info && $info->{attrs}{accessor}
+ && $info->{attrs}{accessor} eq 'single')
+ {
+ 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})
+ {
+ $self->set_inflated_column($key, delete $upd->{$key});
+ }
+ }
+ }
+ $self->set_columns($upd);
+}
+
=head2 copy
my $copy = $orig->copy({ change => $to, ... });
bless $new, ref $self;
$new->result_source($self->result_source);
- $new->set_columns($changes);
+ $new->set_inflated_columns($changes);
$new->insert;
+
+ # Its possible we'll have 2 relations to the same Source. We need to make
+ # sure we don't try to insert the same row twice esle we'll violate unique
+ # constraints
+ my $rels_copied = {};
+
foreach my $rel ($self->result_source->relationships) {
my $rel_info = $self->result_source->relationship_info($rel);
- if ($rel_info->{attrs}{cascade_copy}) {
- my $resolved = $self->result_source->resolve_condition(
- $rel_info->{cond}, $rel, $new);
- foreach my $related ($self->search_related($rel)) {
- $related->copy($resolved);
- }
+
+ next unless $rel_info->{attrs}{cascade_copy};
+
+ my $resolved = $self->result_source->resolve_condition(
+ $rel_info->{cond}, $rel, $new
+ );
+
+ my $copied = $rels_copied->{ $rel_info->{source} } ||= {};
+ foreach my $related ($self->search_related($rel)) {
+ my $id_str = join("\0", $related->id);
+ next if $copied->{$id_str};
+ $copied->{$id_str} = 1;
+ my $rel_copy = $related->copy($resolved);
}
+
}
return $new;
}
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(@_);
}
}
+=head2 id
+
+Returns the primary key(s) for a row. Can't be called as a class method.
+Actually implemented in L<DBIx::Class::Pk>
+
+=head2 discard_changes
+
+Re-selects the row from the database, losing any changes that had
+been made.
+
+This method can also be used to refresh from storage, retrieving any
+changes made since the row was last read from storage. Actually
+implemented in L<DBIx::Class::Pk>
+
+=cut
+
1;
=head1 AUTHORS
projects / dbsrgits/DBIx-Class.git / blobdiff