Fix ::Ordered in combination with delete_all
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Ordered.pm
index 0b4384b..a5db68b 100644 (file)
@@ -275,7 +275,7 @@ sub last_sibling {
     return defined $lsib ? $lsib : 0;
 }
 
-# an optimized method to get the last sibling position value without inflating a row object
+# an optimized method to get the last sibling position value without inflating a result object
 sub _last_sibling_posval {
     my $self = shift;
     my $position_column = $self->position_column;
@@ -367,7 +367,30 @@ sub move_to {
 
     my $position_column = $self->position_column;
 
-    if ($self->is_column_changed ($position_column) ) {
+    my $is_txn;
+    if ($is_txn = $self->result_source->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,
+        ( $self->result_source
+                ->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 +403,7 @@ sub move_to {
       return 0;
     }
 
-    my $guard = $self->result_source->schema->txn_scope_guard;
+    my $guard = $is_txn ? undef : $self->result_source->schema->txn_scope_guard;
 
     my ($direction, @between);
     if ( $from_position < $to_position ) {
@@ -402,7 +425,7 @@ sub move_to {
     $self->_shift_siblings ($direction, @between);
     $self->_ordered_internal_update({ $position_column => $new_pos_val });
 
-    $guard->commit;
+    $guard->commit if $guard;
     return 1;
 }
 
@@ -581,19 +604,11 @@ sub delete {
 
     $self->move_last;
 
-    my @res;
-    if (not defined wantarray) {
-        $self->next::method( @_ );
-    }
-    elsif (wantarray) {
-        @res = $self->next::method( @_ );
-    }
-    else {
-        $res[0] = $self->next::method( @_ );
-    }
+    $self->next::method( @_ );
 
     $guard->commit;
-    return wantarray ? @res : $res[0];
+
+    return $self;
 }
 
 # add the current position/group to the things we track old values for
@@ -715,30 +730,22 @@ sub _shift_siblings {
 
     my $shift_rs = $self->_group_rs-> search ({ $position_column => { -between => \@between } });
 
-    # some databases (sqlite) are dumb and can not do a blanket
-    # 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)
-
+    # some databases (sqlite, pg, perhaps others) are dumb and can not do a
+    # blanket increment/decrement without violating a unique constraint.
+    # 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.
     my $rsrc = $self->result_source;
 
     # 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;
+        my $rs = $rsrc->resultset;
 
         my @all_data = $cursor->all;
         while (my $data = shift @all_data) {
@@ -756,28 +763,16 @@ sub _shift_siblings {
     }
 }
 
-=head1 PRIVATE METHODS
-
-These methods are used internally.  You should never have the
-need to use them.
-
-=head2 _group_rs
 
-This method returns a resultset containing all members of the row
-group (including the row itself).
-
-=cut
+# This method returns a resultset containing all members of the row
+# group (including the row itself).
 sub _group_rs {
     my $self = shift;
     return $self->result_source->resultset->search({$self->_grouping_clause()});
 }
 
-=head2 _siblings
-
-Returns an unordered resultset of all objects in the same group
-excluding the object you called this method on.
-
-=cut
+# Returns an unordered resultset of all objects in the same group
+# excluding the object you called this method on.
 sub _siblings {
     my $self = shift;
     my $position_column = $self->position_column;
@@ -790,38 +785,24 @@ sub _siblings {
     ;
 }
 
-=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
+# 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.
 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.
-
-=cut
+# 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.
 sub _grouping_clause {
     my( $self ) = @_;
     return map {  $_ => $self->get_column($_)  } $self->_grouping_columns();
 }
 
-=head2 _get_grouping_columns
-
-Returns a list of the column names used for grouping, regardless of whether
-they were specified as an arrayref or a single string, and returns ()
-if there is no grouping.
-
-=cut
+# Returns a list of the column names used for grouping, regardless of whether
+# they were specified as an arrayref or a single string, and returns ()
+# if there is no grouping.
 sub _grouping_columns {
     my( $self ) = @_;
     my $col = $self->grouping_column();
@@ -834,13 +815,7 @@ sub _grouping_columns {
     }
 }
 
-=head2 _is_in_group
-
-    $item->_is_in_group( {user => 'fred', list => 'work'} )
-
-Returns true if the object is in the group represented by hashref $other
-
-=cut
+# Returns true if the object is in the group represented by hashref $other
 sub _is_in_group {
     my ($self, $other) = @_;
     my $current = {$self->_grouping_clause};
@@ -858,23 +833,18 @@ 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<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
-
+# 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<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.
 sub _ordered_internal_update {
     my $self = shift;
     local $self->result_source->schema->{_ORDERED_INTERNAL_UPDATE} = 1;
@@ -914,18 +884,18 @@ 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<DBIx::Class::Row/discard_changes>.
-
-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.
+If you have multiple same-group result objects already loaded from storage,
+you need to be careful when executing C<move_*> operations on them:
+without a L</position_column> reload the L</_position_value> of the
+"siblings" will be out of sync with the underlying storage.
+
+Starting from version C<0.082800> DBIC will implicitly perform such
+reloads when the C<move_*> 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<DBIx::Class::Row/discard_changes> to get an object
+up-to-date before proceeding, otherwise undefined behavior will result.
 
 =head2 Default Values