X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FOrdered.pm;h=bf7f954ff55c6da6e8f60a1c13432e215a095afd;hb=f064a2abb15858bb39a141ad50391d4191988d2c;hp=a5db68bdad759c33db421bb70ccd1dcf7ca0e2fd;hpb=37b9b05b2fd693c01ef01a29765fba97077393d2;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Ordered.pm b/lib/DBIx/Class/Ordered.pm
index a5db68b..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<ordered> 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</_siblings>
+a resultset with no ordering applied use C<_siblings>
 
 =cut
 sub siblings {
@@ -367,8 +364,10 @@ sub move_to {
 
     my $position_column = $self->position_column;
 
+    my $rsrc = $self->result_source;
+
     my $is_txn;
-    if ($is_txn = $self->result_source->schema->storage->transaction_depth) {
+    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
@@ -378,8 +377,7 @@ sub move_to {
 
       $self->store_column(
         $position_column,
-        ( $self->result_source
-                ->resultset
+        (  $rsrc->resultset
                  ->search($self->_storage_ident_condition, { rows => 1, columns => $position_column })
                   ->cursor
                    ->next
@@ -403,7 +401,7 @@ sub move_to {
       return 0;
     }
 
-    my $guard = $is_txn ? undef : $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 ) {
@@ -418,7 +416,7 @@ 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 });
     }
 
@@ -564,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
@@ -614,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
@@ -678,7 +680,7 @@ L</_next_position_value> below. Defaults to 1.
 
 =cut
 
-__PACKAGE__->mk_classdata( '_initial_position_value' => 1 );
+__PACKAGE__->mk_classaccessor( '_initial_position_value' => 1 );
 
 =head2 _next_position_value
 
@@ -740,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 {
@@ -902,15 +897,13 @@ up-to-date before proceeding, otherwise undefined behavior will result.
 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 <bluefeet@cpan.org>
-
- Constraints support and code generalisation
-   Peter Rabbitson <ribasushi@cpan.org>
+=head1 FURTHER QUESTIONS?
 
-=head1 LICENSE
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
 
-You may distribute this code under the same terms as Perl itself.
+=head1 COPYRIGHT AND LICENSE
 
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.