X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FOrdered.pm;fp=lib%2FDBIx%2FClass%2FOrdered.pm;h=cef565efd36cc4c05751601118e0ca5265eb9970;hp=bf7f954ff55c6da6e8f60a1c13432e215a095afd;hb=dc7d89911b7bb98c30208cf73af522a99998dcd6;hpb=9ab0364d36a4357b766f6dfccfb1df5ef69b079b

diff --git a/lib/DBIx/Class/Ordered.pm b/lib/DBIx/Class/Ordered.pm
index bf7f954..cef565e 100644
--- a/lib/DBIx/Class/Ordered.pm
+++ b/lib/DBIx/Class/Ordered.pm
@@ -3,6 +3,9 @@ use strict;
 use warnings;
 use base qw( DBIx::Class );
 
+use DBIx::Class::_Util qw( bag_eq fail_on_internal_call );
+use namespace::clean;
+
 =head1 NAME
 
 DBIx::Class::Ordered - Modify the position of objects in an ordered list.
@@ -143,13 +146,28 @@ __PACKAGE__->mk_classaccessor( 'null_position_value' => 0 );
 Returns an B<ordered> resultset of all other objects in the same
 group excluding the one you called it on.
 
+Underneath calls L<DBIx::Class::ResultSet/search>, and therefore returns
+objects by implicitly invoking L<C<< ->all() >>|DBIx::Class::ResultSet/all>
+in list context.
+
 The ordering is a backwards-compatibility artifact - if you need
 a resultset with no ordering applied use C<_siblings>
 
 =cut
+
 sub siblings {
-    my $self = shift;
-    return $self->_siblings->search ({}, { order_by => $self->position_column } );
+    #my $self = shift;
+
+    DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS
+      and
+    wantarray
+      and
+    ! eval { fail_on_internal_call; 1 }
+      and
+    die "ILLEGAL LIST CONTEXT INVOCATION: $@";
+
+    # *MUST* be context sensitive due to legacy (DO NOT call search_rs)
+    $_[0]->_siblings->search ({}, { order_by => $_[0]->position_column } );
 }
 
 =head2 previous_siblings
@@ -160,15 +178,29 @@ sub siblings {
 Returns a resultset of all objects in the same group
 positioned before the object on which this method was called.
 
+Underneath calls L<DBIx::Class::ResultSet/search>, and therefore returns
+objects by implicitly invoking L<C<< ->all() >>|DBIx::Class::ResultSet/all>
+in list context.
+
 =cut
 sub previous_siblings {
     my $self = shift;
     my $position_column = $self->position_column;
     my $position = $self->get_column ($position_column);
-    return ( defined $position
+
+    DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS
+      and
+    wantarray
+      and
+    ! eval { fail_on_internal_call; 1 }
+      and
+    die "ILLEGAL LIST CONTEXT INVOCATION: $@";
+
+    # *MUST* be context sensitive due to legacy (DO NOT call search_rs)
+    defined( $position )
         ? $self->_siblings->search ({ $position_column => { '<', $position } })
         : $self->_siblings
-    );
+    ;
 }
 
 =head2 next_siblings
@@ -179,15 +211,29 @@ sub previous_siblings {
 Returns a resultset of all objects in the same group
 positioned after the object on which this method was called.
 
+Underneath calls L<DBIx::Class::ResultSet/search>, and therefore returns
+objects by implicitly invoking L<C<< ->all() >>|DBIx::Class::ResultSet/all>
+in list context.
+
 =cut
 sub next_siblings {
     my $self = shift;
     my $position_column = $self->position_column;
     my $position = $self->get_column ($position_column);
-    return ( defined $position
+
+    DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS
+      and
+    wantarray
+      and
+    ! eval { fail_on_internal_call; 1 }
+      and
+    die "ILLEGAL LIST CONTEXT INVOCATION: $@";
+
+    # *MUST* be context sensitive due to legacy (DO NOT call search_rs)
+    defined( $position )
         ? $self->_siblings->search ({ $position_column => { '>', $position } })
         : $self->_siblings
-    );
+    ;
 }
 
 =head2 previous_sibling
@@ -203,12 +249,12 @@ sub previous_sibling {
     my $self = shift;
     my $position_column = $self->position_column;
 
-    my $psib = $self->previous_siblings->search(
+    my $psib = $self->previous_siblings->search_rs(
         {},
         { rows => 1, order_by => { '-desc' => $position_column } },
     )->single;
 
-    return defined $psib ? $psib : 0;
+    return defined( $psib ) ? $psib : 0;
 }
 
 =head2 first_sibling
@@ -224,12 +270,12 @@ sub first_sibling {
     my $self = shift;
     my $position_column = $self->position_column;
 
-    my $fsib = $self->previous_siblings->search(
+    my $fsib = $self->previous_siblings->search_rs(
         {},
         { rows => 1, order_by => { '-asc' => $position_column } },
     )->single;
 
-    return defined $fsib ? $fsib : 0;
+    return defined( $fsib ) ? $fsib : 0;
 }
 
 =head2 next_sibling
@@ -244,12 +290,12 @@ if the current object is the last one.
 sub next_sibling {
     my $self = shift;
     my $position_column = $self->position_column;
-    my $nsib = $self->next_siblings->search(
+    my $nsib = $self->next_siblings->search_rs(
         {},
         { rows => 1, order_by => { '-asc' => $position_column } },
     )->single;
 
-    return defined $nsib ? $nsib : 0;
+    return defined( $nsib ) ? $nsib : 0;
 }
 
 =head2 last_sibling
@@ -264,12 +310,12 @@ sibling.
 sub last_sibling {
     my $self = shift;
     my $position_column = $self->position_column;
-    my $lsib = $self->next_siblings->search(
+    my $lsib = $self->next_siblings->search_rs(
         {},
         { rows => 1, order_by => { '-desc' => $position_column } },
     )->single;
 
-    return defined $lsib ? $lsib : 0;
+    return defined( $lsib ) ? $lsib : 0;
 }
 
 # an optimized method to get the last sibling position value without inflating a result object
@@ -277,13 +323,12 @@ sub _last_sibling_posval {
     my $self = shift;
     my $position_column = $self->position_column;
 
-    my $cursor = $self->next_siblings->search(
+    my $cursor = $self->next_siblings->search_rs(
         {},
         { rows => 1, order_by => { '-desc' => $position_column }, select => $position_column },
     )->cursor;
 
-    my ($pos) = $cursor->next;
-    return $pos;
+    ($cursor->next)[0];
 }
 
 =head2 move_previous
@@ -378,7 +423,7 @@ sub move_to {
       $self->store_column(
         $position_column,
         (  $rsrc->resultset
-                 ->search($self->_storage_ident_condition, { rows => 1, columns => $position_column })
+                 ->search_rs($self->_storage_ident_condition, { rows => 1, columns => $position_column })
                   ->cursor
                    ->next
         )[0] || $self->throw_exception(
@@ -730,7 +775,7 @@ sub _shift_siblings {
         $ord = 'desc';
     }
 
-    my $shift_rs = $self->_group_rs-> search ({ $position_column => { -between => \@between } });
+    my $shift_rs = $self->_group_rs-> search_rs ({ $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.
@@ -746,7 +791,7 @@ sub _shift_siblings {
     ) {
         my $clean_rs = $rsrc->resultset;
 
-        for ( $shift_rs->search (
+        for ( $shift_rs->search_rs (
           {}, { order_by => { "-$ord", $position_column }, select => [$position_column, @pcols] }
         )->cursor->all ) {
           my $pos = shift @$_;
@@ -762,8 +807,18 @@ sub _shift_siblings {
 # 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()});
+    #my $self = shift;
+
+    DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS
+      and
+    wantarray
+      and
+    ! eval { fail_on_internal_call; 1 }
+      and
+    die "ILLEGAL LIST CONTEXT INVOCATION: $@";
+
+    # *MUST* be context sensitive due to legacy (DO NOT call search_rs)
+    $_[0]->result_source->resultset->search({ $_[0]->_grouping_clause() });
 }
 
 # Returns an unordered resultset of all objects in the same group
@@ -772,7 +827,17 @@ sub _siblings {
     my $self = shift;
     my $position_column = $self->position_column;
     my $pos;
-    return defined ($pos = $self->get_column($position_column))
+
+    DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS
+      and
+    wantarray
+      and
+    ! eval { fail_on_internal_call; 1 }
+      and
+    die "ILLEGAL LIST CONTEXT INVOCATION: $@";
+
+    # *MUST* be context sensitive due to legacy (DO NOT call search_rs)
+    defined( $pos = $self->get_column($position_column) )
         ? $self->_group_rs->search(
             { $position_column => { '!=' => $pos } },
           )
@@ -815,17 +880,26 @@ sub _is_in_group {
     my ($self, $other) = @_;
     my $current = {$self->_grouping_clause};
 
-    no warnings qw/uninitialized/;
-
-    return 0 if (
-        join ("\x00", sort keys %$current)
-            ne
-        join ("\x00", sort keys %$other)
-    );
-    for my $key (keys %$current) {
-        return 0 if $current->{$key} ne $other->{$key};
-    }
-    return 1;
+    (
+      bag_eq(
+        [ keys %$current ],
+        [ keys %$other ],
+      )
+        and
+      ! grep {
+        (
+          defined( $current->{$_} )
+            xor
+          defined( $other->{$_} )
+        )
+          or
+        (
+          defined $current->{$_}
+            and
+          $current->{$_} ne $other->{$_}
+        )
+      } keys %$other
+    ) ? 1 : 0;
 }
 
 # This is a short-circuited method, that is used internally by this
@@ -841,9 +915,8 @@ sub _is_in_group {
 # 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;
-    return $self->update (@_);
+    local $_[0]->result_source->schema->{_ORDERED_INTERNAL_UPDATE} = 1;
+    shift->update (@_);
 }
 
 1;