Fix unique constraint violations in Ordered.pm blanket movement (RT#79773)

This essentially reverts 5e6fde33e5 which was applied without much thinking.
Added a test to ensure this doesn't re-break again.

diff --git a/Changes b/Changes
index 59eba7a..c865454 100644 (file)
--- a/Changes
+++ b/Changes
@@ -4,6 +4,8 @@ Revision history for DBIx::Class
         - SQLMaker now accepts \'literal' with the 'for' rs attribute as an
           override to the builtin FOR options
     * Fixes
+        - Fix unique constraint violations in Ordered.pm blanket movement
+          (RT#79773, rolls back short-sighted 5e6fde33e)
         - Fix test failure on perl 5.8
 
 0.08203 2012-10-18

diff --git a/lib/DBIx/Class/Ordered.pm b/lib/DBIx/Class/Ordered.pm
index 8a50e25..9395767 100644 (file)
--- a/lib/DBIx/Class/Ordered.pm
+++ b/lib/DBIx/Class/Ordered.pm
@@ -705,9 +705,39 @@ sub _shift_siblings {
         $ord = 'desc';
     }
 
-    $self->_group_rs
-          ->search ({ $position_column => { -between => \@between } })
-           ->update ({ $position_column => \ "$position_column $op 1" } );
+    my $shift_rs = $self->_group_rs-> search ({ $position_column => { -between => \@between } });
+
+    # 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;
+    if (
+      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 = $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 ) });
+        }
+    }
+    else {
+        $shift_rs->update ({ $position_column => \ "$position_column $op 1" } );
+    }
 }
 
 

diff --git a/t/ordered/cascade_delete.t b/t/ordered/cascade_delete.t
index 45379a6..b6633c7 100644 (file)
--- a/t/ordered/cascade_delete.t
+++ b/t/ordered/cascade_delete.t
@@ -6,12 +6,8 @@ use Test::Exception;
 use lib qw(t/lib);
 use DBICTest;
 
-use POSIX qw(ceil);
-
 my $schema = DBICTest->init_schema();
 
-plan tests => 1;
-
 {
   my $artist = $schema->resultset ('Artist')->search ({}, { rows => 1})->single; # braindead sqlite
   my $cd = $schema->resultset ('CD')->create ({
@@ -28,4 +24,4 @@ plan tests => 1;
   lives_ok (sub { $cd->delete}, "Cascade delete on ordered has_many doesn't bomb");
 }
 
-1;
+done_testing;

diff --git a/t/ordered/unordered_movement.t b/t/ordered/unordered_movement.t
new file mode 100644 (file)
index 0000000..9cbc3da
--- /dev/null
+++ b/t/ordered/unordered_movement.t
@@ -0,0 +1,27 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+my $cd = $schema->resultset('CD')->next;
+
+lives_ok {
+  $cd->tracks->delete;
+
+  my @tracks = map
+    { $cd->create_related('tracks', { title => "t_$_", position => $_ }) }
+    (4,2,5,1,3)
+  ;
+
+  for (@tracks) {
+    $_->discard_changes;
+    $_->delete;
+  }
+} 'Creation/deletion of out-of order tracks successful';
+
+done_testing;