[Bast-commits] r5645 - in DBIx-Class/0.08/trunk: lib/DBIx/Class t

ribasushi at dev.catalyst.perl.org ribasushi at dev.catalyst.perl.org
Wed Feb 25 08:14:16 GMT 2009


Author: ribasushi
Date: 2009-02-25 08:14:16 +0000 (Wed, 25 Feb 2009)
New Revision: 5645

Modified:
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Ordered.pm
   DBIx-Class/0.08/trunk/t/87ordered.t
Log:
Wrap dangerous Ordered operations in transactions (still needs optimisations wrt sibling shifting)

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Ordered.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Ordered.pm	2009-02-25 05:16:07 UTC (rev 5644)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Ordered.pm	2009-02-25 08:14:16 UTC (rev 5645)
@@ -349,8 +349,9 @@
 
     my $position_column = $self->position_column;
 
-    # FIXME this needs to be wrapped in a transaction
     {
+        my $guard = $self->result_source->schema->txn_scope_guard;
+
         my ($direction, @between);
         if ( $from_position < $to_position ) {
             $direction = -1;
@@ -371,6 +372,8 @@
         $self->_shift_siblings ($direction, @between);
         $self->_ordered_internal_update({ $position_column => $new_pos_val });
 
+        $guard->commit;
+
         return 1;
     }
 }
@@ -412,8 +415,9 @@
         return $self->move_to ($to_position);
     }
 
-    # FIXME this needs to be wrapped in a transaction
     {
+        my $guard = $self->result_source->schema->txn_scope_guard;
+
         # Move to end of current group to adjust siblings
         $self->move_last;
 
@@ -436,6 +440,8 @@
 
         $self->_ordered_internal_update;
 
+        $guard->commit;
+
         return 1;
     }
 }
@@ -493,8 +499,9 @@
         return $self->next::method( \%changes, @_ );
     }
 
-    # 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) ) {
 
@@ -522,7 +529,20 @@
             $self->move_to(delete $changes{$position_column});
         }
 
-        return $self->next::method( \%changes, @_ );
+        my @res;
+        my $want = wantarray();
+        if (not defined $want) {
+            $self->next::method( \%changes, @_ );
+        }
+        elsif ($want) {
+            @res = $self->next::method( \%changes, @_ );
+        }
+        else {
+            $res[0] = $self->next::method( \%changes, @_ );
+        }
+
+        $guard->commit;
+        return $want ? @res : $res[0];
     }
 }
 
@@ -536,11 +556,25 @@
 
 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
@@ -818,8 +852,12 @@
 
 =head1 AUTHOR
 
-Aran Deltac <bluefeet at cpan.org>
+ Original code framework
+   Aran Deltac <bluefeet at cpan.org>
 
+ Constraints support and code generalisation
+   Peter Rabbitson <ribasushi at cpan.org>
+
 =head1 LICENSE
 
 You may distribute this code under the same terms as Perl itself.

Modified: DBIx-Class/0.08/trunk/t/87ordered.t
===================================================================
--- DBIx-Class/0.08/trunk/t/87ordered.t	2009-02-25 05:16:07 UTC (rev 5644)
+++ DBIx-Class/0.08/trunk/t/87ordered.t	2009-02-25 08:14:16 UTC (rev 5645)
@@ -42,11 +42,15 @@
 my $group_3 = $employees->search({group_id=>3});
 my $to_group = 1;
 my $to_pos = undef;
-while (my $employee = $group_3->next) {
-	$employee->discard_changes;     # since we are effective shift()ing the $rs
-	$employee->move_to_group($to_group, $to_pos);
-	$to_pos++;
-	$to_group = $to_group==1 ? 2 : 1;
+# 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;
+  }
 }
 foreach my $group_id (1..4) {
     my $group_employees = $employees->search({group_id=>$group_id});
@@ -124,12 +128,17 @@
 my $to_group_2_base = 7;
 my $to_group_2 = 1;
 $to_pos = undef;
-while (my $employee = $group_4->next) {
-	$employee->move_to_group({group_id_2=>$to_group, group_id_3=>$to_group_2}, $to_pos);
-	$to_pos++;
+
+# now that we have transactions we need to work around stupid sqlite
+{
+  my @empl = $group_3->all;
+  while (my $employee = shift @empl) {
+    $employee->move_to_group({group_id_2=>$to_group, group_id_3=>$to_group_2}, $to_pos);
+    $to_pos++;
     $to_group = ($to_group % 3) + 1;
     $to_group_2_base++;
     $to_group_2 = (ceil($to_group_2_base/3.0) %3) +1
+  }
 }
 foreach my $group_id_2 (1..4) {
     foreach my $group_id_3 (1..4) {




More information about the Bast-commits mailing list