);
# Optional: group_id INTEGER NOT NULL
-In your Schema or DB class add Ordered to the top
+In your Schema or DB class add "Ordered" to the top
of the component list.
__PACKAGE__->load_components(qw( Ordered ... ));
__PACKAGE__->position_column('position');
__PACKAGE__->grouping_column('group_id'); # optional
-Thats it, now you can change the position of your objects.
+That's it, now you can change the position of your objects.
#!/use/bin/perl
use My::Item;
__PACKAGE__->position_column('position');
Sets and retrieves the name of the column that stores the
-positional value of each record. Default to "position".
+positional value of each record. Defaults to "position".
=cut
__PACKAGE__->grouping_column('group_id');
-This method specified a column to limit all queries in
+This method specifies a column to limit all queries in
this module by. This effectively allows you to have multiple
ordered lists within the same table.
my $rs = $item->siblings();
my @siblings = $item->siblings();
-Returns either a result set or an array of all other objects
+Returns either a resultset or an array of all other objects
excluding the one you called it on.
=cut
my $sibling = $item->first_sibling();
Returns the first sibling object, or 0 if the first sibling
-is this sibliing.
+is this sibling.
=cut
my $sibling = $item->last_sibling();
-Return the last sibling, or 0 if the last sibling is this
+Returns the last sibling, or 0 if the last sibling is this
sibling.
=cut
my $sibling = $item->previous_sibling();
-Returns the sibling that resides one position back. Undef
-is returned if the current object is the first one.
+Returns the sibling that resides one position back. Returns undef
+if the current object is the first one.
=cut
my $sibling = $item->next_sibling();
-Returns the sibling that resides one position foward. Undef
-is returned if the current object is the last one.
+Returns the sibling that resides one position forward. Returns undef
+if the current object is the last one.
=cut
$item->move_previous();
-Swaps position with the sibling on position previous in the list.
-1 is returned on success, and 0 is returned if the objects is already
-the first one.
+Swaps position with the sibling in the position previous in
+the list. Returns 1 on success, and 0 if the object is
+already the first one.
=cut
$item->move_next();
-Swaps position with the sibling in the next position. 1 is returned on
-success, and 0 is returned if the object is already the last in the list.
+Swaps position with the sibling in the next position in the
+list. Returns 1 on success, and 0 if the object is already
+the last in the list.
=cut
$item->move_first();
-Moves the object to the first position. 1 is returned on
-success, and 0 is returned if the object is already the first.
+Moves the object to the first position in the list. Returns 1
+on success, and 0 if the object is already the first.
=cut
$item->move_last();
-Moves the object to the very last position. 1 is returned on
-success, and 0 is returned if the object is already the last one.
+Moves the object to the last position in the list. Returns 1
+on success, and 0 if the object is already the last one.
=cut
$item->move_to( $position );
-Moves the object to the specified position. 1 is returned on
-success, and 0 is returned if the object is already at the
-specified position.
+Moves the object to the specified position. Returns 1 on
+success, and 0 if the object is already at the specified
+position.
=cut
my $from_position = $self->get_column( $position_column );
return 0 if ( $to_position < 1 );
return 0 if ( $from_position==$to_position );
+ my @between = (
+ ( $from_position < $to_position )
+ ? ( $from_position+1, $to_position )
+ : ( $to_position, $from_position-1 )
+ );
my $rs = $self->result_source->resultset->search({
- -and => [
- $position_column => { ($from_position>$to_position?'<':'>') => $from_position },
- $position_column => { ($from_position>$to_position?'>=':'<=') => $to_position },
- ],
+ $position_column => { -between => [ @between ] },
$self->_grouping_clause(),
});
my $op = ($from_position>$to_position) ? '+' : '-';
- $rs->update({
- $position_column => \"$position_column $op 1",
- });
- $self->set_column( $position_column => $to_position );
- $self->update();
+ $rs->update({ $position_column => \"$position_column $op 1" });
+ $self->update({ $position_column => $to_position });
return 1;
}
=head2 _grouping_clause
-This method returns a name=>value pare for limiting a search
+This method returns a name=>value pair for limiting a search
by the collection column. If the collection column is not
defined then this will return an empty list.
=head1 BUGS
+=head2 Unique Constraints
+
+Unique indexes and constraints on the position column are not
+supported at this time. It would be make sense to support them,
+but there are some unexpected database issues that make this
+hard to do. The main problem from the author's view is that
+SQLite (the DB engine that we use for testing) does not support
+ORDER BY on updates.
+
=head2 Race Condition on Insert
If a position is not specified for an insert than a position
will be chosen based on COUNT(*)+1. But, it first selects the
-count then inserts the record. The space of time between select
+count, and then inserts the record. The space of time between select
and insert introduces a race condition. To fix this we need the
ability to lock tables in DBIC. I've added an entry in the TODO
about this.
the position of the other object will not reflect their new value
until you reload them from the database.
-The are times when you will want to move objects as groups, such
+There are times when you will want to move objects as groups, such
as changeing the parent of several objects at once - this directly
conflicts with this problem. One solution is for us to write a
ResultSet class that supports a parent() method, for example. Another