X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FOrdered.pm;h=bf7f954ff55c6da6e8f60a1c13432e215a095afd;hb=c5340bfac7aff784999be6ab4fa803fd9440043f;hp=5e40dc0c25c5333f50695d114f4798b21f4d2cae;hpb=fb13a49f17a0e0a49638080a4bd826fb3702aebe;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Ordered.pm b/lib/DBIx/Class/Ordered.pm index 5e40dc0..bf7f954 100644 --- a/lib/DBIx/Class/Ordered.pm +++ b/lib/DBIx/Class/Ordered.pm @@ -3,9 +3,6 @@ use strict; 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. @@ -109,7 +106,7 @@ positional value of each record. Defaults to "position". =cut -__PACKAGE__->mk_classdata( 'position_column' => 'position' ); +__PACKAGE__->mk_classaccessor( 'position_column' => 'position' ); =head2 grouping_column @@ -121,7 +118,7 @@ ordered lists within the same table. =cut -__PACKAGE__->mk_classdata( 'grouping_column' ); +__PACKAGE__->mk_group_accessors( inherited => 'grouping_column' ); =head2 null_position_value @@ -136,7 +133,7 @@ indeed start from 0. =cut -__PACKAGE__->mk_classdata( 'null_position_value' => 0 ); +__PACKAGE__->mk_classaccessor( 'null_position_value' => 0 ); =head2 siblings @@ -147,7 +144,7 @@ Returns an B resultset of all other objects in the same group excluding the one you called it on. The ordering is a backwards-compatibility artifact - if you need -a resultset with no ordering applied use L +a resultset with no ordering applied use C<_siblings> =cut sub siblings { @@ -367,7 +364,31 @@ sub move_to { my $position_column = $self->position_column; - if ($self->is_column_changed ($position_column) ) { + my $rsrc = $self->result_source; + + my $is_txn; + if ($is_txn = $rsrc->schema->storage->transaction_depth) { + # Reload position state from storage + # The thinking here is that if we are in a transaction, it is + # *more likely* the object went out of sync due to resultset + # level shenanigans. Instead of always reloading (slow) - go + # ahead and hand-hold only in the case of higher layers + # requesting the safety of a txn + + $self->store_column( + $position_column, + ( $rsrc->resultset + ->search($self->_storage_ident_condition, { rows => 1, columns => $position_column }) + ->cursor + ->next + )[0] || $self->throw_exception( + sprintf "Unable to locate object '%s' in storage - object went ouf of sync...?", + $self->ID + ), + ); + delete $self->{_dirty_columns}{$position_column}; + } + elsif ($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}); @@ -380,7 +401,7 @@ sub move_to { return 0; } - my $guard = $self->result_source->schema->txn_scope_guard; + my $guard = $is_txn ? undef : $rsrc->schema->txn_scope_guard; my ($direction, @between); if ( $from_position < $to_position ) { @@ -395,14 +416,14 @@ sub move_to { 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 }} ) ) ) { + if (grep { $_ eq $position_column } ( map { @$_ } (values %{{ $rsrc->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; + $guard->commit if $guard; return 1; } @@ -541,7 +562,7 @@ sub update { if (! keys %$changed_ordering_cols) { return $self->next::method( undef, @_ ); } - elsif (defined first { exists $changed_ordering_cols->{$_} } @group_columns ) { + elsif (grep { 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 @@ -591,7 +612,11 @@ sub delete { # 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); + return ( + $self->next::method($col) + || + grep { $_ eq $col } ($self->position_column, $self->_grouping_columns) + ); } =head1 METHODS FOR EXTENDING ORDERED @@ -655,7 +680,7 @@ L below. Defaults to 1. =cut -__PACKAGE__->mk_classdata( '_initial_position_value' => 1 ); +__PACKAGE__->mk_classaccessor( '_initial_position_value' => 1 ); =head2 _next_position_value @@ -717,22 +742,15 @@ sub _shift_siblings { local $rsrc->schema->{_ORDERED_INTERNAL_UPDATE} = 1; my @pcols = $rsrc->primary_columns; if ( - first { $_ eq $position_column } ( map { @$_ } (values %{{ $rsrc->unique_constraints }} ) ) + grep { $_ eq $position_column } ( map { @$_ } (values %{{ $rsrc->unique_constraints }} ) ) ) { - my $cursor = $shift_rs->search ( + my $clean_rs = $rsrc->resultset; + + for ( $shift_rs->search ( {}, { order_by => { "-$ord", $position_column }, select => [$position_column, @pcols] } - )->cursor; - my $rs = $rsrc->resultset; - - 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]} = $data->[$i]; - } - - $rs->find($cond)->update ({ $position_column => $pos + ( ($op eq '+') ? 1 : -1 ) }); + )->cursor->all ) { + my $pos = shift @$_; + $clean_rs->find(@$_)->update ({ $position_column => $pos + ( ($op eq '+') ? 1 : -1 ) }); } } else { @@ -861,33 +879,31 @@ will prevent such race conditions going undetected. =head2 Multiple Moves -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. +If you have multiple same-group result objects already loaded from storage, +you need to be careful when executing C operations on them: +without a L reload the L of the +"siblings" will be out of sync with the underlying storage. -There are times when you will want to move objects as groups, such -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. +Starting from version C<0.082800> DBIC will implicitly perform such +reloads when the C happens as a part of a transaction +(a good example of such situation is C<< $ordered_resultset->delete_all >>). + +If it is not possible for you to wrap the entire call-chain in a transaction, +you will need to call L to get an object +up-to-date before proceeding, otherwise undefined behavior will result. =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 - - Original code framework - Aran Deltac - - Constraints support and code generalisation - Peter Rabbitson +=head1 FURTHER QUESTIONS? -=head1 LICENSE +Check the list of L. -You may distribute this code under the same terms as Perl itself. +=head1 COPYRIGHT AND LICENSE +This module is free software L +by the L. You can +redistribute it and/or modify it under the same terms as the +L.