use warnings;
use base qw( DBIx::Class );
+use List::Util 'first';
+use namespace::clean;
+
=head1 NAME
DBIx::Class::Ordered - Modify the position of objects in an ordered list.
my $position_column = $self->position_column;
- my $guard;
-
if ($self->is_column_changed ($position_column) ) {
- # something changed our position, we have no idea where we
- # used to be - requery without using discard_changes
- # (we need only a specific column back)
-
- $guard = $self->result_source->schema->txn_scope_guard;
-
- my $cursor = $self->result_source->resultset->search(
- $self->ident_condition,
- { select => $position_column },
- )->cursor;
-
- my ($pos) = $cursor->next;
- $self->$position_column ($pos);
+ # something changed our position, we need to know where we
+ # used to be - use the stashed value
+ $self->store_column($position_column, delete $self->{_column_data_in_storage}{$position_column});
delete $self->{_dirty_columns}{$position_column};
}
my $from_position = $self->_position;
if ( $from_position == $to_position ) { # FIXME this will not work for non-numeric order
- $guard->commit if $guard;
return 0;
}
- $guard ||= $self->result_source->schema->txn_scope_guard;
+ my $guard = $self->result_source->schema->txn_scope_guard;
my ($direction, @between);
if ( $from_position < $to_position ) {
return 0 if ( defined($to_position) and $to_position < 1 );
# check if someone changed the _grouping_columns - this will
- # prevent _is_in_group working, so we need to requery the db
- # for the original values
- my (@dirty_cols, %values, $guard);
+ # prevent _is_in_group working, so we need to restore the
+ # original stashed values
for ($self->_grouping_columns) {
- $values{$_} = $self->get_column ($_);
- push @dirty_cols, $_ if $self->is_column_changed ($_);
- }
-
- # re-query only the dirty columns, and restore them on the
- # object (subsequent code will update them to the correct
- # after-move values)
- if (@dirty_cols) {
- $guard = $self->result_source->schema->txn_scope_guard;
-
- my $cursor = $self->result_source->resultset->search(
- $self->ident_condition,
- { select => \@dirty_cols },
- )->cursor;
-
- my @original_values = $cursor->next;
- $self->set_inflated_columns ({ %values, map { $_ => shift @original_values } (@dirty_cols) });
- delete $self->{_dirty_columns}{$_} for (@dirty_cols);
+ if ($self->is_column_changed ($_)) {
+ $self->store_column($_, delete $self->{_column_data_in_storage}{$_});
+ delete $self->{_dirty_columns}{$_};
+ }
}
if ($self->_is_in_group ($to_group) ) {
$ret = $self->move_to ($to_position);
}
- $guard->commit if $guard;
return $ret||0;
}
- $guard ||= $self->result_source->schema->txn_scope_guard;
+ my $guard = $self->result_source->schema->txn_scope_guard;
# Move to end of current group to adjust siblings
$self->move_last;
=cut
sub update {
- my $self = shift;
-
- # this is set by _ordered_internal_update()
- return $self->next::method(@_) if $self->{_ORDERED_INTERNAL_UPDATE};
-
- my $position_column = $self->position_column;
- my @ordering_columns = ($self->_grouping_columns, $position_column);
-
-
- # these steps are necessary to keep the external appearance of
- # ->update($upd) so that other things overloading update() will
- # work properly
- my %original_values = $self->get_columns;
- my %existing_changes = $self->get_dirty_columns;
-
- # See if any of the *supplied* changes would affect the ordering
- # The reason this is so contrived, is that we want to leverage
- # the datatype aware value comparing, while at the same time
- # keep the original value intact (it will be updated later by the
- # corresponding routine)
-
- my %upd = %{shift || {}};
- my %changes = %existing_changes;
-
- for (@ordering_columns) {
- next unless exists $upd{$_};
-
- # we do not want to keep propagating this to next::method
- # as it will be a done deal by the time get there
- my $value = delete $upd{$_};
- $self->set_inflated_columns ({ $_ => $value });
-
- # see if an update resulted in a dirty column
- # it is important to preserve the old value, as it
- # will be needed to carry on a successfull move()
- # operation without re-querying the database
- if ($self->is_column_changed ($_) && not exists $existing_changes{$_}) {
- $changes{$_} = $value;
- $self->set_inflated_columns ({ $_ => $original_values{$_} });
- delete $self->{_dirty_columns}{$_};
- }
- }
-
- # if nothing group/position related changed - short circuit
- if (not grep { exists $changes{$_} } ( @ordering_columns ) ) {
- return $self->next::method( \%upd, @_ );
- }
-
- {
- my $guard = $self->result_source->schema->txn_scope_guard;
-
- # if any of our grouping columns have been changed
- if (grep { exists $changes{$_} } ($self->_grouping_columns) ) {
-
- # create new_group by taking the current group and inserting changes
- my $new_group = {$self->_grouping_clause};
- foreach my $col (keys %$new_group) {
- $new_group->{$col} = $changes{$col} if exists $changes{$col};
- }
-
- $self->move_to_group(
- $new_group,
- (exists $changes{$position_column}
- # The FIXME bit contradicts the documentation: POD states that
- # when changing groups without supplying explicit positions in
- # move_to_group(), we push the item to the end of the group.
- # However when I was rewriting this, the position from the old
- # group was clearly passed to the new one
- # Probably needs to go away (by ribasushi)
- ? $changes{$position_column} # means there was a position change supplied with the update too
- : $self->_position # FIXME! (replace with undef)
- ),
- );
- }
- elsif (exists $changes{$position_column}) {
- $self->move_to($changes{$position_column});
- }
-
- my @res;
- if (not defined wantarray) {
- $self->next::method( \%upd, @_ );
- }
- elsif (wantarray) {
- @res = $self->next::method( \%upd, @_ );
- }
- else {
- $res[0] = $self->next::method( \%upd, @_ );
- }
+ my $self = shift;
+
+ # this is set by _ordered_internal_update()
+ return $self->next::method(@_) if $self->{_ORDERED_INTERNAL_UPDATE};
+
+ my $upd = shift;
+ $self->set_inflated_columns($upd) if $upd;
+
+ my $position_column = $self->position_column;
+ my @group_columns = $self->_grouping_columns;
+
+ # see if the order is already changed
+ my $changed_ordering_cols = { map { $_ => $self->get_column($_) } grep { $self->is_column_changed($_) } ($position_column, @group_columns) };
+
+ # nothing changed - short circuit
+ if (! keys %$changed_ordering_cols) {
+ return $self->next::method( undef, @_ );
+ }
+ elsif (defined first { exists $changed_ordering_cols->{$_} } @group_columns ) {
+ $self->move_to_group(
+ # since the columns are already re-set the _grouping_clause is correct
+ # move_to_group() knows how to get the original storage values
+ { $self->_grouping_clause },
+
+ # The FIXME bit contradicts the documentation: POD states that
+ # when changing groups without supplying explicit positions in
+ # move_to_group(), we push the item to the end of the group.
+ # However when I was rewriting this, the position from the old
+ # group was clearly passed to the new one
+ # Probably needs to go away (by ribasushi)
+ (exists $changed_ordering_cols->{$position_column}
+ ? $changed_ordering_cols->{$position_column} # means there was a position change supplied with the update too
+ : $self->_position # FIXME! (replace with undef)
+ ),
+ );
+ }
+ else {
+ $self->move_to($changed_ordering_cols->{$position_column});
+ }
- $guard->commit;
- return wantarray ? @res : $res[0];
- }
+ return $self;
}
=head2 delete
-Overrides the DBIC delete() method by first moving the object
+Overrides the DBIC delete() method by first moving the object
to the last position, then deleting it, thus ensuring the
integrity of the positions.
return wantarray ? @res : $res[0];
}
+# add the current position/group to the things we track old values for
+sub _track_storage_value {
+ my ($self, $col) = @_;
+ return $self->next::method($col) || defined first { $_ eq $col } ($self->position_column, $self->_grouping_columns);
+}
+
=head1 METHODS FOR EXTENDING ORDERED
You would want to override the methods below if you use sparse
sub _siblings {
my $self = shift;
my $position_column = $self->position_column;
- return $self->_group_rs->search(
- { $position_column => { '!=' => $self->get_column($position_column) } },
- );
+ return defined (my $pos = $self->get_column($position_column))
+ ? $self->_group_rs->search(
+ { $position_column => { '!=' => $self->get_column($position_column) } },
+ )
+ : $self->_group_rs
+ ;
}
=head2 _position
use DBIx::Class::Exception;
use Scalar::Util 'blessed';
+use List::Util 'first';
use Try::Tiny;
###
);
}
+ delete $self->{_column_data_in_storage};
+ $self->in_storage(1);
+
$self->{_dirty_columns} = {};
$self->{related_resultsets} = {};
}
}
- $self->in_storage(1);
- delete $self->{_orig_ident};
- delete $self->{_orig_ident_failreason};
delete $self->{_ignore_at_insert};
+
$rollback_guard->commit if $rollback_guard;
return $self;
my %to_update = $self->get_dirty_columns
or return $self;
- my $ident_cond = $self->{_orig_ident} || $self->ident_condition;
$self->throw_exception( "Not in database" ) unless $self->in_storage;
- $self->throw_exception($self->{_orig_ident_failreason})
- if ! keys %$ident_cond;
-
my $rows = $self->result_source->storage->update(
- $self->result_source, \%to_update, $ident_cond
+ $self->result_source, \%to_update, $self->ident_condition
);
if ($rows == 0) {
$self->throw_exception( "Can't update ${self}: row not found" );
}
$self->{_dirty_columns} = {};
$self->{related_resultsets} = {};
- delete $self->{_orig_ident};
+ delete $self->{_column_data_in_storage};
return $self;
}
if (ref $self) {
$self->throw_exception( "Not in database" ) unless $self->in_storage;
- my $ident_cond = $self->{_orig_ident} || $self->ident_condition;
- $self->throw_exception($self->{_orig_ident_failreason})
- if ! keys %$ident_cond;
-
$self->result_source->storage->delete(
- $self->result_source, $ident_cond
+ $self->result_source, $self->ident_condition
);
- delete $self->{_orig_ident}; # no longer identifiable
+ delete $self->{_column_data_in_storage};
$self->in_storage(undef);
}
else {
sub set_column {
my ($self, $column, $new_value) = @_;
- # if we can't get an ident condition on first try - mark the object as unidentifiable
- # (by using an empty hashref) and store the error for further diag
- unless ($self->{_orig_ident}) {
- try {
- $self->{_orig_ident} = $self->ident_condition
- }
- catch {
- $self->{_orig_ident_failreason} = $_;
- $self->{_orig_ident} = {};
- };
- }
+ my $had_value = $self->has_column_loaded($column);
+ my ($old_value, $in_storage) = ($self->get_column($column), $self->in_storage)
+ if $had_value;
- my $old_value = $self->get_column($column);
$new_value = $self->store_column($column, $new_value);
my $dirty =
$self->{_dirty_columns}{$column}
||
- $self->in_storage # no point tracking dirtyness on uninserted data
+ $in_storage # no point tracking dirtyness on uninserted data
? ! $self->_eq_column_values ($column, $old_value, $new_value)
: 1
;
delete $self->{_inflated_column}{$rel};
}
}
+
+ if (
+ # value change from something (even if NULL)
+ $had_value
+ and
+ # no storage - no storage-value
+ $in_storage
+ and
+ # no value already stored (multiple changes before commit to storage)
+ ! exists $self->{_column_data_in_storage}{$column}
+ and
+ $self->_track_storage_value($column)
+ ) {
+ $self->{_column_data_in_storage}{$column} = $old_value;
+ }
}
return $new_value;
}
}
+# returns a boolean indicating if the passed column should have its original
+# value tracked between column changes and commitment to storage
+sub _track_storage_value {
+ my ($self, $col) = @_;
+ return defined first { $col eq $_ } ($self->primary_columns);
+}
+
=head2 set_columns
$row->set_columns({ $col => $val, ... });
$resultset = $resultset->search(undef, $attrs);
}
- my $ident_cond = $self->{_orig_ident} || $self->ident_condition;
-
- $self->throw_exception($self->{_orig_ident_failreason})
- if ! keys %$ident_cond;
-
- return $resultset->find($ident_cond);
+ return $resultset->find($self->ident_condition);
}
=head2 discard_changes ($attrs?)
projects / dbsrgits/DBIx-Class.git / commitdiff