X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FOrdered.pm;h=7842a4059d7913e8be0c9bff3f0b5e571ec03ece;hb=48580715af3072905f2c71dc27e7f70f21a11338;hp=e95b693a1d5bb5396029a761b3b5ac53d8ae95a1;hpb=bd7ca9e8410a23a8becfc3c99468fc0b5c25affc;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Ordered.pm b/lib/DBIx/Class/Ordered.pm index e95b693..7842a40 100644 --- a/lib/DBIx/Class/Ordered.pm +++ b/lib/DBIx/Class/Ordered.pm @@ -60,20 +60,20 @@ That's it, now you can change the position of your objects. #!/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(); @@ -127,7 +127,7 @@ __PACKAGE__->mk_classdata( 'grouping_column' ); This method specifies a value of L which B 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. @@ -272,6 +272,20 @@ sub last_sibling { 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(); @@ -299,7 +313,7 @@ the last in the list. 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); } @@ -327,7 +341,11 @@ on success, and 0 if the object is already the last one. 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 @@ -344,30 +362,58 @@ sub move_to { my( $self, $to_position ) = @_; return 0 if ( $to_position < 1 ); + 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); + delete $self->{_dirty_columns}{$position_column}; + } + my $from_position = $self->_position; - return 0 if ( $from_position == $to_position ); - my $position_column = $self->position_column; + if ( $from_position == $to_position ) { # FIXME this will not work for non-numeric order + $guard->commit if $guard; + return 0; + } - # FIXME this needs to be wrapped in a transaction - { - 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 ||= $self->result_source->schema->txn_scope_guard; - 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 - $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 ); + } - return 1; + my $new_pos_val = $self->_position_value ($to_position); # record this before the shift + + # 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 @@ -388,10 +434,7 @@ if multiple grouping columns are in use. 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; @@ -402,37 +445,72 @@ sub move_to_group { my $position_column = $self->position_column; return 0 if ( defined($to_position) and $to_position < 1 ); - if ($self->_is_in_group ($to_group) ) { - return 0 if not defined $to_position; - return $self->move_to ($to_position); + + # 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); + for ($self->_grouping_columns) { + $values{$_} = $self->get_column ($_); + push @dirty_cols, $_ if $self->is_column_changed ($_); } - # FIXME this needs to be wrapped in a transaction - { - # Move to end of current group to adjust siblings - $self->move_last; + # 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; - $self->set_inflated_columns({ %$to_group, $position_column => undef }); - my $new_group_count = $self->_group_rs->count; + my $cursor = $self->result_source->resultset->search( + $self->ident_condition, + { select => \@dirty_cols }, + )->cursor; - 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->get_column ($position_column) ) # FIXME - no need to inflate last_sibling - : $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 ); - } + my @original_values = $cursor->next; + $self->set_inflated_columns ({ %values, map { $_ => shift @original_values } (@dirty_cols) }); + delete $self->{_dirty_columns}{$_} for (@dirty_cols); + } - $self->_ordered_internal_update; + if ($self->_is_in_group ($to_group) ) { + my $ret; + if (defined $to_position) { + $ret = $self->move_to ($to_position); + } + + $guard->commit if $guard; + return $ret||0; + } - return 1; + $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_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_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; + + $guard->commit; + + return 1; } =head2 insert @@ -448,10 +526,10 @@ sub insert { 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 ) ); @@ -476,48 +554,93 @@ sub update { # 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; + 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{$_} } ($self->_grouping_columns, $position_column) ) { - return $self->next::method( \%changes, @_ ); + if (not grep { exists $changes{$_} } ( @ordering_columns ) ) { + return $self->next::method( \%upd, @_ ); } - # 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) ) { # 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 - } + $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: 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 + # 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) - ? delete $changes{$position_column} # means there was a position change supplied with the update too - : $self->_position # FIXME! + ? $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(delete $changes{$position_column}); + $self->move_to($changes{$position_column}); + } + + my @res; + my $want = wantarray(); + if (not defined $want) { + $self->next::method( \%upd, @_ ); + } + elsif ($want) { + @res = $self->next::method( \%upd, @_ ); + } + else { + $res[0] = $self->next::method( \%upd, @_ ); } - return $self->next::method( \%changes, @_ ); + $guard->commit; + return $want ? @res : $res[0]; } } @@ -531,43 +654,60 @@ integrity of the positions. 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 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 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. +Returns the B of an object with a B 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 my $pos_value = $item->_position_value ( $pos ) -Returns the value of L of the object at numeric +Returns the B of L of the object at numeric position C<$pos>. By default simply returns C<$pos>. =cut @@ -589,7 +729,7 @@ sub _position_value { __PACKAGE__->_initial_position_value(0); -This method specifies a value of L which is assigned +This method specifies a B of L 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 below. Defaults to 1. @@ -602,7 +742,7 @@ __PACKAGE__->mk_classdata( '_initial_position_value' => 1 ); my $new_value = $item->_next_position_value ( $position_value ) -Returns a position value that would be considered C with +Returns a position B that would be considered C 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 @@ -618,10 +758,16 @@ sub _next_position_value { $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 value -by 1. +Shifts all siblings with B 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 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 the shift is not a trivial task. +Refer to the implementation source of the default method for more +information. =cut sub _shift_siblings { @@ -647,13 +793,22 @@ 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; + + while (my @pks = $cursor->next ) { + + my $cond; + for my $i (0.. $#pcols) { + $cond->{$pcols[$i]} = $pks[$i]; + } - 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" } ); + $rs->search($cond)->update ({ $position_column => \ "$position_column $op 1" } ); } } else { @@ -668,7 +823,7 @@ need to use them. =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 @@ -691,11 +846,24 @@ sub _siblings { ); } +=head2 _position + + my $num_pos = $item->_position; + +Returns the B 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 { @@ -746,6 +914,23 @@ sub _is_in_group { 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 (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 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; @@ -771,22 +956,31 @@ will prevent such race conditions going undetected. =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. 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 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 + Original code framework + Aran Deltac + + Constraints support and code generalisation + Peter Rabbitson =head1 LICENSE