From: Peter Rabbitson <ribasushi@cpan.org>
Date: Sat, 8 Aug 2009 15:02:39 +0000 (+0000)
Subject: Stop using discard_changes() in Ordered (if I knew it will be *that* complex I would... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=87b4a87703747efd8a8d785a118d30647596c8ae;p=dbsrgits%2FDBIx-Class-Historic.git

Stop using discard_changes() in Ordered (if I knew it will be *that* complex I would not touch it)
---

diff --git a/lib/DBIx/Class/Ordered.pm b/lib/DBIx/Class/Ordered.pm
index 9f2e253..be06d3b 100644
--- a/lib/DBIx/Class/Ordered.pm
+++ b/lib/DBIx/Class/Ordered.pm
@@ -362,38 +362,58 @@ sub 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;
+    my $guard;
 
-        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 );
-        }
+    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)
 
-        my $new_pos_val = $self->_position_value ($to_position);                              # record this before the shift
+      $guard = $self->result_source->schema->txn_scope_guard;
 
-        # 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 $cursor = $self->result_source->resultset->search(
+        $self->ident_condition,
+        { select => $position_column },
+      )->cursor;
 
-        $self->_shift_siblings ($direction, @between);
-        $self->_ordered_internal_update({ $position_column => $new_pos_val });
+      my ($pos) = $cursor->next;
+      $self->$position_column ($pos);
+      delete $self->{_dirty_columns}{$position_column};
+    }
 
-        $guard->commit;
+    my $from_position = $self->_position;
 
-        return 1;
+    if ( $from_position == $to_position ) {   # FIXME this will not work for non-numeric order
+      $guard->commit if $guard;
+      return 0;
     }
+
+    $guard ||= $self->result_source->schema->txn_scope_guard;
+
+    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 $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
@@ -428,43 +448,71 @@ 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 ($_);
     }
 
-    {
-        my $guard = $self->result_source->schema->txn_scope_guard;
+    # 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;
 
-        # Move to end of current group to adjust siblings
-        $self->move_last;
+      my $cursor = $self->result_source->resultset->search(
+        $self->ident_condition,
+        { select => \@dirty_cols },
+      )->cursor;
 
-        $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
-        );
+      my @original_values = $cursor->next;
+      $self->set_inflated_columns ({ %values, map { $_ => shift @original_values } (@dirty_cols) });
+    }
 
-        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 = ($to_position, $new_group_last_position);
-            $self->_shift_siblings (1, @between);   #shift right
-            $self->set_column( $position_column => $bumped_pos_val );
-        }
+    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;
+    }
 
-        $self->_ordered_internal_update;
+    $guard ||= $self->result_source->schema->txn_scope_guard;
 
-        $guard->commit;
+    # Move to end of current group to adjust siblings
+    $self->move_last;
 
-        return 1;
+    $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 = ($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
@@ -508,16 +556,47 @@ 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_inflated_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, @_ );
     }
 
     {
@@ -529,37 +608,37 @@ sub update {
             # 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( \%changes, @_ );
+            $self->next::method( \%upd, @_ );
         }
         elsif ($want) {
-            @res = $self->next::method( \%changes, @_ );
+            @res = $self->next::method( \%upd, @_ );
         }
         else {
-            $res[0] = $self->next::method( \%changes, @_ );
+            $res[0] = $self->next::method( \%upd, @_ );
         }
 
         $guard->commit;
@@ -790,8 +869,8 @@ sub _siblings {
 =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 {
diff --git a/t/87ordered.t b/t/87ordered.t
index 1d9f17a..9ca9c2e 100644
--- a/t/87ordered.t
+++ b/t/87ordered.t
@@ -10,8 +10,6 @@ use POSIX qw(ceil);
 
 my $schema = DBICTest->init_schema();
 
-plan tests => 1269;
-
 my $employees = $schema->resultset('Employee');
 $employees->delete();
 
@@ -42,11 +40,9 @@ foreach my $group_id (1..4) {
 my $group_3 = $employees->search({group_id=>3});
 my $to_group = 1;
 my $to_pos = undef;
-# now that we have transactions we need to work around stupid sqlite
 {
   my @empl = $group_3->all;
   while (my $employee = shift @empl) {
-    $employee->discard_changes;     # since we are effective shift()ing the $rs while doing this
     $employee->move_to_group($to_group, $to_pos);
     $to_pos++;
     $to_group = $to_group==1 ? 2 : 1;
@@ -54,7 +50,6 @@ my $to_pos = undef;
 }
 foreach my $group_id (1..4) {
     my $group_employees = $employees->search({group_id=>$group_id});
-    $group_employees->all();
     ok( check_rs($group_employees), "group positions after move_to_group" );
 }
 
@@ -129,7 +124,6 @@ my $to_group_2_base = 7;
 my $to_group_2 = 1;
 $to_pos = undef;
 
-# now that we have transactions we need to work around stupid sqlite
 {
   my @empl = $group_3->all;
   while (my $employee = shift @empl) {
@@ -143,7 +137,6 @@ $to_pos = undef;
 foreach my $group_id_2 (1..4) {
     foreach my $group_id_3 (1..4) {
         my $group_employees = $employees->search({group_id_2=>$group_id_2,group_id_3=>$group_id_3});
-        $group_employees->all();
         ok( check_rs($group_employees), "group positions after move_to_group" );
     }
 }
@@ -275,3 +268,4 @@ sub check_rs {
     return 1;
 }
 
+done_testing;