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.
#!/use/bin/perl
use My::Item;
-
+
my $item = My::Item->create({ name=>'Matt S. Trout' });
# If using grouping_column:
my $item = My::Item->create({ name=>'Matt S. Trout', group_id=>1 });
-
+
my $rs = $item->siblings();
my @siblings = $item->siblings();
-
+
my $sibling;
$sibling = $item->first_sibling();
$sibling = $item->last_sibling();
$sibling = $item->previous_sibling();
$sibling = $item->next_sibling();
-
+
$item->move_previous();
$item->move_next();
$item->move_first();
This method specifies a value of L</position_column> which B<would
never be assigned to a row> during normal operation. When
a row is moved, its position is set to this value temporarily, so
-that any unique constrainst can not be violated. This value defaults
+that any unique constraints can not be violated. This value defaults
to 0, which should work for all cases except when your positions do
indeed start from 0.
return defined $lsib ? $lsib : 0;
}
-# an optimised method to get the last sibling position without inflating a row object
-sub _last_sibling_pos {
+# an optimized method to get the last sibling position value without inflating a row object
+sub _last_sibling_posval {
my $self = shift;
my $position_column = $self->position_column;
my $cursor = $self->next_siblings->search(
{},
- { rows => 1, order_by => { '-desc' => $position_column }, columns => $position_column },
+ { rows => 1, order_by => { '-desc' => $position_column }, select => $position_column },
)->cursor;
my ($pos) = $cursor->next;
sub move_next {
my $self = shift;
- return 0 unless $self->next_siblings->count;
+ return 0 unless defined $self->_last_sibling_posval; # quick way to check for no more siblings
return $self->move_to ($self->_position + 1);
}
sub move_last {
my $self = shift;
- return $self->move_to( $self->_group_rs->count );
+ my $last_posval = $self->_last_sibling_posval;
+
+ return 0 unless defined $last_posval;
+
+ return $self->move_to( $self->_position_from_value ($last_posval) );
}
=head2 move_to
my( $self, $to_position ) = @_;
return 0 if ( $to_position < 1 );
- my $from_position = $self->_position;
- return 0 if ( $from_position == $to_position );
-
my $position_column = $self->position_column;
- {
- my $guard = $self->result_source->schema->txn_scope_guard;
+ if ($self->is_column_changed ($position_column) ) {
+ # 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 ($direction, @between);
- if ( $from_position < $to_position ) {
- $direction = -1;
- @between = map { $self->_position_value ($_) } ( $from_position + 1, $to_position );
- }
- else {
- $direction = 1;
- @between = map { $self->_position_value ($_) } ( $to_position, $from_position - 1 );
- }
+ my $from_position = $self->_position;
- my $new_pos_val = $self->_position_value ($to_position); # record this before the shift
+ if ( $from_position == $to_position ) { # FIXME this will not work for non-numeric order
+ return 0;
+ }
- # we need to null-position the moved row if the position column is part of a constraint
- if (grep { $_ eq $position_column } ( map { @$_ } (values %{{ $self->result_source->unique_constraints }} ) ) ) {
- $self->_ordered_internal_update({ $position_column => $self->null_position_value });
- }
+ my $guard = $self->result_source->schema->txn_scope_guard;
- $self->_shift_siblings ($direction, @between);
- $self->_ordered_internal_update({ $position_column => $new_pos_val });
+ my ($direction, @between);
+ if ( $from_position < $to_position ) {
+ $direction = -1;
+ @between = map { $self->_position_value ($_) } ( $from_position + 1, $to_position );
+ }
+ else {
+ $direction = 1;
+ @between = map { $self->_position_value ($_) } ( $to_position, $from_position - 1 );
+ }
- $guard->commit;
+ my $new_pos_val = $self->_position_value ($to_position); # record this before the shift
- return 1;
+ # we need to null-position the moved row if the position column is part of a constraint
+ if (grep { $_ eq $position_column } ( map { @$_ } (values %{{ $self->result_source->unique_constraints }} ) ) ) {
+ $self->_ordered_internal_update({ $position_column => $self->null_position_value });
}
+
+ $self->_shift_siblings ($direction, @between);
+ $self->_ordered_internal_update({ $position_column => $new_pos_val });
+
+ $guard->commit;
+ return 1;
}
=head2 move_to_group
sub move_to_group {
my( $self, $to_group, $to_position ) = @_;
- $self->throw_exception ('move_to_group() expects a group specification')
- unless defined $to_group;
-
- # if we're given a string, turn it into a hashref
+ # if we're given a single value, turn it into a hashref
unless (ref $to_group eq 'HASH') {
my @gcols = $self->_grouping_columns;
my $position_column = $self->position_column;
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 restore the
+ # original stashed values
+ for ($self->_grouping_columns) {
+ 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) ) {
- return 0 if not defined $to_position;
- return $self->move_to ($to_position);
+ my $ret;
+ if (defined $to_position) {
+ $ret = $self->move_to ($to_position);
+ }
+
+ return $ret||0;
}
- {
- my $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;
+ # Move to end of current group to adjust siblings
+ $self->move_last;
- $self->set_inflated_columns({ %$to_group, $position_column => undef });
- my $new_group_count = $self->_group_rs->count;
+ $self->set_inflated_columns({ %$to_group, $position_column => undef });
+ my $new_group_last_posval = $self->_last_sibling_posval;
+ my $new_group_last_position = $self->_position_from_value (
+ $new_group_last_posval
+ );
- if ( not defined($to_position) or $to_position > $new_group_count) {
- $self->set_column(
- $position_column => $new_group_count
- ? $self->_next_position_value ( $self->_last_sibling_pos )
- : $self->_initial_position_value
- );
- }
- else {
- my $bumped_pos_val = $self->_position_value ($to_position);
- my @between = ($to_position, $new_group_count);
- $self->_shift_siblings (1, @between); #shift right
- $self->set_column( $position_column => $bumped_pos_val );
- }
+ if ( not defined($to_position) or $to_position > $new_group_last_position) {
+ $self->set_column(
+ $position_column => $new_group_last_position
+ ? $self->_next_position_value ( $new_group_last_posval )
+ : $self->_initial_position_value
+ );
+ }
+ else {
+ my $bumped_pos_val = $self->_position_value ($to_position);
+ my @between = map { $self->_position_value ($_) } ($to_position, $new_group_last_position);
+ $self->_shift_siblings (1, @between); #shift right
+ $self->set_column( $position_column => $bumped_pos_val );
+ }
- $self->_ordered_internal_update;
+ $self->_ordered_internal_update;
- $guard->commit;
+ $guard->commit;
- return 1;
- }
+ return 1;
}
=head2 insert
my $position_column = $self->position_column;
unless ($self->get_column($position_column)) {
- my $lsib_pos = $self->_last_sibling_pos;
+ my $lsib_posval = $self->_last_sibling_posval;
$self->set_column(
- $position_column => (defined $lsib_pos
- ? $self->_next_position_value ( $lsib_pos )
+ $position_column => (defined $lsib_posval
+ ? $self->_next_position_value ( $lsib_posval )
: $self->_initial_position_value
)
);
=cut
sub update {
- 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 %changes = $self->get_dirty_columns;
- $self->discard_changes;
-
- my $position_column = $self->position_column;
-
- # if nothing group/position related changed - short circuit
- if (not grep { exists $changes{$_} } ($self->_grouping_columns, $position_column) ) {
- return $self->next::method( \%changes, @_ );
- }
-
- {
- 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) {
- if (exists $changes{$col}) {
- $new_group->{$col} = delete $changes{$col}; # don't want to pass this on to next::method
- }
- }
-
- $self->move_to_group(
- $new_group,
- (exists $changes{$position_column}
- # The FIXME bit contradicts the documentation: 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)
- ? delete $changes{$position_column} # means there was a position change supplied with the update too
- : $self->_position # FIXME!
- ),
- );
- }
- elsif (exists $changes{$position_column}) {
- $self->move_to(delete $changes{$position_column});
- }
-
- my @res;
- my $want = wantarray();
- if (not defined $want) {
- $self->next::method( \%changes, @_ );
- }
- elsif ($want) {
- @res = $self->next::method( \%changes, @_ );
- }
- else {
- $res[0] = $self->next::method( \%changes, @_ );
- }
+ my $self = shift;
+
+ # this is set by _ordered_internal_update()
+ return $self->next::method(@_) if $self->result_source->schema->{_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 $want ? @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.
$self->move_last;
my @res;
- my $want = wantarray();
- if (not defined $want) {
+ if (not defined wantarray) {
$self->next::method( @_ );
}
- elsif ($want) {
+ elsif (wantarray) {
@res = $self->next::method( @_ );
}
else {
}
$guard->commit;
- return $want ? @res : $res[0];
+ 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
if you are working with preexisting non-normalised position data,
or if you need to work with materialized path columns.
-=head2 _position
+=head2 _position_from_value
- my $num_pos = $item->_position;
+ my $num_pos = $item->_position_from_value ( $pos_value )
-Returns the B<absolute numeric position> of the current object, with the
-first object being at position 1, its sibling at position 2 and so on.
-By default simply returns the value of L</position_column>.
+Returns the B<absolute numeric position> of an object with a B<position
+value> set to C<$pos_value>. By default simply returns C<$pos_value>.
=cut
-sub _position {
- my $self = shift;
+sub _position_from_value {
+ my ($self, $val) = @_;
+
+ return 0 unless defined $val;
# #the right way to do this
-# return $self->previous_siblings->count + 1;
+# return $self -> _group_rs
+# -> search({ $self->position_column => { '<=', $val } })
+# -> count
- return $self->get_column ($self->position_column);
+ return $val;
}
=head2 _position_value
Shifts all siblings with B<positions values> in the range @between
(inclusive) by one position as specified by $direction (left if < 0,
right if > 0). By default simply increments/decrements each
-L<position_column> value by 1, doing so in a way as to not violate
+L</position_column> value by 1, doing so in a way as to not violate
any existing constraints.
Note that if you override this method and have unique constraints
-including the L<position_column> the shift is not a trivial task.
+including the L</position_column> the shift is not a trivial task.
Refer to the implementation source of the default method for more
information.
# increment/decrement. So what we do here is check if the
# position column is part of a unique constraint, and do a
# one-by-one update if this is the case
+ # Also we do a one-by-one if the position is part of the PK
+ # since once we update a column via scalarref we lose the
+ # ability to retrieve this column back (we do not know the
+ # id anymore)
my $rsrc = $self->result_source;
- if (grep { $_ eq $position_column } ( map { @$_ } (values %{{ $rsrc->unique_constraints }} ) ) ) {
-
- my @pcols = $rsrc->primary_columns;
- my $cursor = $shift_rs->search ({}, { order_by => { "-$ord", $position_column }, columns => \@pcols } )->cursor;
+ # set in case there are more cascades combined with $rs->update => $rs_update_all overrides
+ local $rsrc->schema->{_ORDERED_INTERNAL_UPDATE} = 1;
+ my @pcols = $rsrc->primary_columns;
+ my $pos_is_pk = first { $_ eq $position_column } @pcols;
+ if (
+ $pos_is_pk
+ or
+ first { $_ eq $position_column } ( map { @$_ } (values %{{ $rsrc->unique_constraints }} ) )
+ ) {
+ my $cursor = $shift_rs->search (
+ {}, { order_by => { "-$ord", $position_column }, select => [$position_column, @pcols] }
+ )->cursor;
my $rs = $self->result_source->resultset;
- while (my @pks = $cursor->next ) {
-
+ my @all_data = $cursor->all;
+ while (my $data = shift @all_data) {
+ my $pos = shift @$data;
my $cond;
for my $i (0.. $#pcols) {
- $cond->{$pcols[$i]} = $pks[$i];
+ $cond->{$pcols[$i]} = $data->[$i];
}
- $rs->search($cond)->update ({ $position_column => \ "$position_column $op 1" } );
+ $rs->find($cond)->update ({ $position_column => $pos + ( ($op eq '+') ? 1 : -1 ) });
}
}
else {
sub _siblings {
my $self = shift;
my $position_column = $self->position_column;
- return $self->_group_rs->search(
- { $position_column => { '!=' => $self->get_column($position_column) } },
- );
+ my $pos;
+ return defined ($pos = $self->get_column($position_column))
+ ? $self->_group_rs->search(
+ { $position_column => { '!=' => $pos } },
+ )
+ : $self->_group_rs
+ ;
+}
+
+=head2 _position
+
+ my $num_pos = $item->_position;
+
+Returns the B<absolute numeric position> of the current object, with the
+first object being at position 1, its sibling at position 2 and so on.
+
+=cut
+sub _position {
+ my $self = shift;
+ return $self->_position_from_value ($self->get_column ($self->position_column) );
}
=head2 _grouping_clause
This method returns one or more name=>value pairs for limiting a search
-by the grouping column(s). If the grouping column is not
-defined then this will return an empty list.
+by the grouping column(s). If the grouping column is not defined then
+this will return an empty list.
=cut
sub _grouping_clause {
triggering any of the positioning integrity code).
Some day you might get confronted by datasets that have ambiguous
-positioning data (i.e. duplicate position values within the same group,
+positioning data (e.g. duplicate position values within the same group,
in a table without unique constraints). When manually fixing such data
keep in mind that you can not invoke L<DBIx::Class::Row/update> like
you normally would, as it will get confused by the wrong data before
sub _ordered_internal_update {
my $self = shift;
- local $self->{_ORDERED_INTERNAL_UPDATE} = 1;
+ local $self->result_source->schema->{_ORDERED_INTERNAL_UPDATE} = 1;
return $self->update (@_);
}
=head1 CAVEATS
+=head2 Resultset Methods
+
+Note that all Insert/Create/Delete overrides are happening on
+L<DBIx::Class::Row> methods only. If you use the
+L<DBIx::Class::ResultSet> versions of
+L<update|DBIx::Class::ResultSet/update> or
+L<delete|DBIx::Class::ResultSet/delete>, all logic present in this
+module will be bypassed entirely (possibly resulting in a broken
+order-tree). Instead always use the
+L<update_all|DBIx::Class::ResultSet/update_all> and
+L<delete_all|DBIx::Class::ResultSet/delete_all> methods, which will
+invoke the corresponding L<row|DBIx::Class::Row> method on every
+member of the given resultset.
+
=head2 Race Condition on Insert
-If a position is not specified for an insert than a position
+If a position is not specified for an insert, a position
will be chosen based either on L</_initial_position_value> or
L</_next_position_value>, depending if there are already some
items in the current group. The space of time between the
=head2 Multiple Moves
-Be careful when issueing move_* methods to multiple objects. If
+Be careful when issuing move_* methods to multiple objects. If
you've pre-loaded the objects then when you move one of the objects
the position of the other object will not reflect their new value
until you reload them from the database - see
L<DBIx::Class::Row/discard_changes>.
There are times when you will want to move objects as groups, such
-as changeing the parent of several objects at once - this directly
+as changing the parent of several objects at once - this directly
conflicts with this problem. One solution is for us to write a
ResultSet class that supports a parent() method, for example. Another
solution is to somehow automagically modify the objects that exist
projects / dbsrgits/DBIx-Class.git / blobdiff