return defined $lsib ? $lsib : 0;
}
+# 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 }, select => $position_column },
+ )->cursor;
+
+ my ($pos) = $cursor->next;
+ return $pos;
+}
+
=head2 move_previous
$item->move_previous();
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 $position_column = $self->position_column;
- # FIXME this needs to be wrapped in a transaction
{
+ my $guard = $self->result_source->schema->txn_scope_guard;
+
my ($direction, @between);
if ( $from_position < $to_position ) {
$direction = -1;
}
my $new_pos_val = $self->_position_value ($to_position); # record this before the shift
- $self->_ordered_internal_update({ $position_column => $self->null_position_value }); # take the row out of the picture for a bit
+
+ # 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;
}
}
return $self->move_to ($to_position);
}
- # FIXME this needs to be wrapped in a transaction
{
+ my $guard = $self->result_source->schema->txn_scope_guard;
+
# 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;
+ 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) {
+ if ( not defined($to_position) or $to_position > $new_group_last_position) {
$self->set_column(
- $position_column => $new_group_count
- ? $self->_next_position_value ( $self->last_sibling->get_column ($position_column) ) # FIXME - no need to inflate last_sibling
+ $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 = ($to_position, $new_group_count);
+ my @between = ($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;
+ $guard->commit;
+
return 1;
}
}
my $position_column = $self->position_column;
unless ($self->get_column($position_column)) {
- my $lsib = $self->last_sibling; # FIXME - no need to inflate last_sibling
+ my $lsib_posval = $self->_last_sibling_posval;
$self->set_column(
- $position_column => ($lsib
- ? $self->_next_position_value ( $lsib->get_column ($position_column) )
+ $position_column => (defined $lsib_posval
+ ? $self->_next_position_value ( $lsib_posval )
: $self->_initial_position_value
)
);
return $self->next::method( \%changes, @_ );
}
- # FIXME this needs to be wrapped in a transaction
{
+ 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) ) {
$self->move_to(delete $changes{$position_column});
}
- return $self->next::method( \%changes, @_ );
+ 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, @_ );
+ }
+
+ $guard->commit;
+ return $want ? @res : $res[0];
}
}
sub delete {
my $self = shift;
- # FIXME this needs to be wrapped in a transaction
- {
- $self->move_last;
- return $self->next::method( @_ );
+
+ my $guard = $self->result_source->schema->txn_scope_guard;
+
+ $self->move_last;
+
+ my @res;
+ my $want = wantarray();
+ if (not defined $want) {
+ $self->next::method( @_ );
+ }
+ elsif ($want) {
+ @res = $self->next::method( @_ );
+ }
+ else {
+ $res[0] = $self->next::method( @_ );
}
+
+ $guard->commit;
+ return $want ? @res : $res[0];
}
-=head1 Methods for extending Ordered
+=head1 METHODS FOR EXTENDING ORDERED
You would want to override the methods below if you use sparse
(non-linear) or non-numeric position values. This can be useful
my $num_pos = $item->_position;
-Returns the absolute numeric position of the current object, with the
+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>.
return $self->get_column ($self->position_column);
}
+=head2 _position_from_value
+
+ my $num_pos = $item->_position_of_value ( $pos_value )
+
+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_from_value {
+ my ($self, $val) = @_;
+
+ return 0 unless defined $val;
+
+# #the right way to do this
+# return $self -> _group_rs
+# -> search({ $self->position_column => { '<=', $val } })
+# -> count
+
+ return $val;
+}
+
=head2 _position_value
my $pos_value = $item->_position_value ( $pos )
-Returns the value of L</position_column> of the object at numeric
+Returns the B<value> of L</position_column> of the object at numeric
position C<$pos>. By default simply returns C<$pos>.
=cut
__PACKAGE__->_initial_position_value(0);
-This method specifies a value of L</position_column> which is assigned
+This method specifies a B<value> of L</position_column> which is assigned
to the first inserted element of a group, if no value was supplied at
insertion time. All subsequent values are derived from this one by
L</_next_position_value> below. Defaults to 1.
my $new_value = $item->_next_position_value ( $position_value )
-Returns a position value that would be considered C<next> with
+Returns a position B<value> that would be considered C<next> with
regards to C<$position_value>. Can be pretty much anything, given
that C<< $position_value < $new_value >> where C<< < >> is the
SQL comparison operator (usually works fine on strings). The
$item->_shift_siblings ($direction, @between)
-Shifts all siblings with position 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.
+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
+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.
+Refer to the implementation source of the default method for more
+information.
=cut
sub _shift_siblings {
# position column is part of a unique constraint, and do a
# one-by-one update if this is the case
- my %uc = $self->result_source->unique_constraints;
- if (grep { $_ eq $position_column } ( map { @$_ } (values %uc) ) ) {
+ 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;
+ my $rs = $self->result_source->resultset;
- my $rs = $shift_rs->search ({}, { order_by => { "-$ord", $position_column } } );
- # FIXME - no need to inflate each row
- while (my $r = $rs->next) {
- $r->_ordered_internal_update ({ $position_column => \ "$position_column $op 1" } );
+ while (my @pks = $cursor->next ) {
+
+ my $cond;
+ for my $i (0.. $#pcols) {
+ $cond->{$pcols[$i]} = $pks[$i];
+ }
+
+ $rs->search($cond)->update ({ $position_column => \ "$position_column $op 1" } );
}
}
else {
=head2 _group_rs
-This method returns a resultset containing all memebers of the row
+This method returns a resultset containing all members of the row
group (including the row itself).
=cut
return 1;
}
+=head2 _ordered_internal_update
+
+This is a short-circuited method, that is used internally by this
+module to update positioning values in isolation (i.e. without
+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,
+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
+having a chance to update the ill-defined row. If you really know what
+you are doing use this method which bypasses any hooks introduced by
+this module.
+
+=cut
+
sub _ordered_internal_update {
my $self = shift;
local $self->{_ORDERED_INTERNAL_UPDATE} = 1;
solution is to somehow automagically modify the objects that exist
in the current object's result set to have the new position value.
+=head2 Default Values
+
+Using a database defined default_value on one of your group columns
+could result in the position not being assigned correctly.
+
=head1 AUTHOR
-Aran Deltac <bluefeet@cpan.org>
+ Original code framework
+ Aran Deltac <bluefeet@cpan.org>
+
+ Constraints support and code generalisation
+ Peter Rabbitson <ribasushi@cpan.org>
=head1 LICENSE
projects / dbsrgits/DBIx-Class.git / blobdiff