view release on metacpan or  search on metacpan

lib/DBIx/Class/Ordered.pm  view on Meta::CPAN

=cut

__PACKAGE__->mk_classdata( '_initial_position_value' => 1 );

=head2 _next_position_value

  my $new_value = $item->_next_position_value ( $position_value )

Returns a position B<value> that would be considered C<next> with
regards to C<$position_value>. Can be pretty much anything, given
that C<< $position_value < $new_value >> where C<< < >> is the
SQL comparison operator (usually works fine on strings). The
default method expects C<$position_value> to be numeric, and
returns C<$position_value + 1>

=cut
sub _next_position_value {
    return $_[1] + 1;
}

=head2 _shift_siblings

  $item->_shift_siblings ($direction, @between)

Shifts all siblings with B<positions values> in the range @between
(inclusive) by one position as specified by $direction (left if < 0,
 right if > 0). By default simply increments/decrements each
L</position_column> value by 1, doing so in a way as to not violate
any existing constraints.

Note that if you override this method and have unique constraints
including the L</position_column> the shift is not a trivial task.
Refer to the implementation source of the default method for more
information.

=cut
sub _shift_siblings {
    my ($self, $direction, @between) = @_;
    return 0 unless $direction;

    my $position_column = $self->position_column;

    my ($op, $ord);
    if ($direction < 0) {
        $op = '-';
        $ord = 'asc';
    }
    else {
        $op = '+';
        $ord = 'desc';
    }

    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 (
      grep { $_ eq $position_column } ( map { @$_ } (values %{{ $rsrc->unique_constraints }} ) )
    ) {
        my $clean_rs = $rsrc->resultset;

        for ( $shift_rs->search (
          {}, { order_by => { "-$ord", $position_column }, select => [$position_column, @pcols] }
        )->cursor->all ) {
          my $pos = shift @$_;
          $clean_rs->find(@$_)->update ({ $position_column => $pos + ( ($op eq '+') ? 1 : -1 ) });
        }
    }
    else {
        $shift_rs->update ({ $position_column => \ "$position_column $op 1" } );
    }
}


# 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()});
}

# Returns an unordered resultset of all objects in the same group
# excluding the object you called this method on.
sub _siblings {
    my $self = shift;
    my $position_column = $self->position_column;
    my $pos;
    return defined ($pos = $self->get_column($position_column))
        ? $self->_group_rs->search(
            { $position_column => { '!=' => $pos } },
          )
        : $self->_group_rs
    ;
}

# Returns the B<absolute numeric position> of the current object, with the
# first object being at position 1, its sibling at position 2 and so on.
sub _position {
    my $self = shift;
    return $self->_position_from_value ($self->get_column ($self->position_column) );
}

# 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.
sub _grouping_clause {
    my( $self ) = @_;
    return map {  $_ => $self->get_column($_)  } $self->_grouping_columns();
}

# Returns a list of the column names used for grouping, regardless of whether
# they were specified as an arrayref or a single string, and returns ()
# if there is no grouping.
sub _grouping_columns {