1 # vim: ts=8:sw=4:sts=4:et
2 package DBIx::Class::Ordered;
5 use base qw( DBIx::Class );
9 DBIx::Class::Ordered - Modify the position of objects in an ordered list.
13 Create a table for your ordered data.
16 item_id INTEGER PRIMARY KEY AUTOINCREMENT,
18 position INTEGER NOT NULL
21 Optionally, add one or more columns to specify groupings, allowing you
22 to maintain independent ordered lists within one table:
25 item_id INTEGER PRIMARY KEY AUTOINCREMENT,
27 position INTEGER NOT NULL,
28 group_id INTEGER NOT NULL
34 item_id INTEGER PRIMARY KEY AUTOINCREMENT,
36 position INTEGER NOT NULL,
37 group_id INTEGER NOT NULL,
38 other_group_id INTEGER NOT NULL
41 In your Schema or DB class add Ordered to the top
42 of the component list.
44 __PACKAGE__->load_components(qw( Ordered ... ));
46 Specify the column that stores the position number for
50 __PACKAGE__->position_column('position');
52 If you are using one grouping column, specify it as follows:
54 __PACKAGE__->grouping_column('group_id');
56 Or if you have multiple grouping columns:
58 __PACKAGE__->grouping_column(['group_id', 'other_group_id']);
60 Thats it, now you can change the position of your objects.
65 my $item = My::Item->create({ name=>'Matt S. Trout' });
66 # If using grouping_column:
67 my $item = My::Item->create({ name=>'Matt S. Trout', group_id=>1 });
69 my $rs = $item->siblings();
70 my @siblings = $item->siblings();
73 $sibling = $item->first_sibling();
74 $sibling = $item->last_sibling();
75 $sibling = $item->previous_sibling();
76 $sibling = $item->next_sibling();
78 $item->move_previous();
82 $item->move_to( $position );
83 $item->move_to_group( 'groupname' );
84 $item->move_to_group( 'groupname', $position );
85 $item->move_to_group( {group_id=>'groupname', 'other_group_id=>'othergroupname'} );
86 $item->move_to_group( {group_id=>'groupname', 'other_group_id=>'othergroupname'}, $position );
90 This module provides a simple interface for modifying the ordered
91 position of DBIx::Class objects.
95 All of the move_* methods automatically update the rows involved in
96 the query. This is not configurable and is due to the fact that if you
97 move a record it always causes other records in the list to be updated.
101 =head2 position_column
103 __PACKAGE__->position_column('position');
105 Sets and retrieves the name of the column that stores the
106 positional value of each record. Default to "position".
110 __PACKAGE__->mk_classdata( 'position_column' => 'position' );
112 =head2 grouping_column
114 __PACKAGE__->grouping_column('group_id');
116 This method specified a column to limit all queries in
117 this module by. This effectively allows you to have multiple
118 ordered lists within the same table.
122 __PACKAGE__->mk_classdata( 'grouping_column' );
126 my $rs = $item->siblings();
127 my @siblings = $item->siblings();
129 Returns either a result set or an array of all other objects
130 excluding the one you called it on.
136 my $position_column = $self->position_column;
137 my $rs = $self->result_source->resultset->search(
139 $position_column => { '!=' => $self->get_column($position_column) },
140 $self->_grouping_clause(),
142 { order_by => $self->position_column },
144 return $rs->all() if (wantarray());
150 my $sibling = $item->first_sibling();
152 Returns the first sibling object, or 0 if the first sibling
159 return 0 if ($self->get_column($self->position_column())==1);
161 return ($self->result_source->resultset->search(
163 $self->position_column => 1,
164 $self->_grouping_clause(),
171 my $sibling = $item->last_sibling();
173 Return the last sibling, or 0 if the last sibling is this
180 my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
181 return 0 if ($self->get_column($self->position_column())==$count);
182 return ($self->result_source->resultset->search(
184 $self->position_column => $count,
185 $self->_grouping_clause(),
190 =head2 previous_sibling
192 my $sibling = $item->previous_sibling();
194 Returns the sibling that resides one position back. Undef
195 is returned if the current object is the first one.
199 sub previous_sibling {
201 my $position_column = $self->position_column;
202 my $position = $self->get_column( $position_column );
203 return 0 if ($position==1);
204 return ($self->result_source->resultset->search(
206 $position_column => $position - 1,
207 $self->_grouping_clause(),
214 my $sibling = $item->next_sibling();
216 Returns the sibling that resides one position foward. Undef
217 is returned if the current object is the last one.
223 my $position_column = $self->position_column;
224 my $position = $self->get_column( $position_column );
225 my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
226 return 0 if ($position==$count);
227 return ($self->result_source->resultset->search(
229 $position_column => $position + 1,
230 $self->_grouping_clause(),
237 $item->move_previous();
239 Swaps position with the sibling on position previous in the list.
240 1 is returned on success, and 0 is returned if the objects is already
247 my $position = $self->get_column( $self->position_column() );
248 return $self->move_to( $position - 1 );
255 Swaps position with the sibling in the next position. 1 is returned on
256 success, and 0 is returned if the object is already the last in the list.
262 my $position = $self->get_column( $self->position_column() );
263 my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
264 return 0 if ($position==$count);
265 return $self->move_to( $position + 1 );
272 Moves the object to the first position. 1 is returned on
273 success, and 0 is returned if the object is already the first.
279 return $self->move_to( 1 );
286 Moves the object to the very last position. 1 is returned on
287 success, and 0 is returned if the object is already the last one.
293 my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
294 return $self->move_to( $count );
299 $item->move_to( $position );
301 Moves the object to the specified position. 1 is returned on
302 success, and 0 is returned if the object is already at the
308 my( $self, $to_position ) = @_;
309 my $position_column = $self->position_column;
310 my $from_position = $self->get_column( $position_column );
311 return 0 if ( $to_position < 1 );
312 return 0 if ( $from_position==$to_position );
314 ( $from_position < $to_position )
315 ? ( $from_position+1, $to_position )
316 : ( $to_position, $from_position-1 )
318 my $rs = $self->result_source->resultset->search({
319 $position_column => { -between => [ @between ] },
320 $self->_grouping_clause(),
322 my $op = ($from_position>$to_position) ? '+' : '-';
323 $rs->update({ $position_column => \"$position_column $op 1" }); #" Sorry, GEdit bug
324 $self->{_ORDERED_INTERNAL_UPDATE} = 1;
325 $self->update({ $position_column => $to_position });
333 $item->move_to_group( $group, $position );
335 Moves the object to the specified position of the specified
336 group, or to the end of the group if $position is undef.
337 1 is returned on success, and 0 is returned if the object is
338 already at the specified position of the specified group.
340 $group may be specified as a single scalar if only one
341 grouping column is in use, or as a hashref of column => value pairs
342 if multiple grouping columns are in use.
347 my( $self, $to_group, $to_position ) = @_;
349 # if we're given a string, turn it into a hashref
350 unless (ref $to_group eq 'HASH') {
351 $to_group = {($self->_grouping_columns)[0] => $to_group};
354 my $position_column = $self->position_column;
355 #my @grouping_columns = $self->_grouping_columns;
357 return 0 if ( ! defined($to_group) );
358 return 0 if ( defined($to_position) and $to_position < 1 );
359 return 0 if ( $self->_is_in_group($to_group)
360 and ((not defined($to_position))
361 or (defined($to_position) and $self->$position_column==$to_position)
365 # Move to end of current group and adjust siblings
368 $self->set_columns($to_group);
369 my $new_group_count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
370 if (!defined($to_position) or $to_position > $new_group_count) {
371 $self->{_ORDERED_INTERNAL_UPDATE} = 1;
372 $self->update({ $position_column => $new_group_count + 1 });
375 my @between = ($to_position, $new_group_count);
377 my $rs = $self->result_source->resultset->search({
378 $position_column => { -between => [ @between ] },
379 $self->_grouping_clause(),
381 $rs->update({ $position_column => \"$position_column + 1" }); #"
382 $self->{_ORDERED_INTERNAL_UPDATE} = 1;
383 $self->update({ $position_column => $to_position });
391 Overrides the DBIC insert() method by providing a default
392 position number. The default will be the number of rows in
393 the table +1, thus positioning the new record at the last position.
399 my $position_column = $self->position_column;
400 $self->set_column( $position_column => $self->result_source->resultset->search( {$self->_grouping_clause()} )->count()+1 )
401 if (!$self->get_column($position_column));
402 return $self->next::method( @_ );
407 Overrides the DBIC update() method by checking for a change
408 to the position and/or group columns. Movement within a
409 group or to another group is handled by repositioning
410 the appropriate siblings. Position defaults to the end
411 of a new group if it has been changed to undef.
418 if ($self->{_ORDERED_INTERNAL_UPDATE}) {
419 delete $self->{_ORDERED_INTERNAL_UPDATE};
420 return $self->next::method( @_ );
423 $self->set_columns($_[0]) if @_ > 0;
424 my %changes = $self->get_dirty_columns;
425 $self->discard_changes;
427 my $pos_col = $self->position_column;
429 # if any of our grouping columns have been changed
430 if (grep {$_} map {exists $changes{$_}} $self->_grouping_columns ) {
432 # create new_group by taking the current group and inserting changes
433 my $new_group = {$self->_grouping_clause};
434 foreach my $col (keys %$new_group) {
435 if (exists $changes{$col}) {
436 $new_group->{$col} = $changes{$col};
437 delete $changes{$col}; # don't want to pass this on to next::method
441 $self->move_to_group(
443 exists($changes{$pos_col}) ? delete($changes{$pos_col}) : $self->$pos_col
446 elsif (exists $changes{$pos_col}) {
447 $self->move_to(delete $changes{$pos_col});
449 return $self->next::method( \%changes );
454 Overrides the DBIC delete() method by first moving the object
455 to the last position, then deleting it, thus ensuring the
456 integrity of the positions.
463 return $self->next::method( @_ );
466 =head1 PRIVATE METHODS
468 These methods are used internally. You should never have the
471 =head2 _grouping_clause
473 This method returns one or more name=>value pairs for limiting a search
474 by the grouping column(s). If the grouping column is not
475 defined then this will return an empty list.
478 sub _grouping_clause {
480 return map { $_ => $self->get_column($_) } $self->_grouping_columns();
485 =head2 _get_grouping_columns
487 Returns a list of the column names used for grouping, regardless of whether
488 they were specified as an arrayref or a single string, and returns ()
489 if there is no grouping.
492 sub _grouping_columns {
494 my $col = $self->grouping_column();
495 if (ref $col eq 'ARRAY') {
506 =head2 _is_in_group($other)
508 $item->_is_in_group( {user => 'fred', list => 'work'} )
510 Returns true if the object is in the group represented by hashref $other
513 my ($self, $other) = @_;
514 my $current = {$self->_grouping_clause};
515 return 0 unless (ref $other eq 'HASH') and (keys %$current == keys %$other);
516 for my $key (keys %$current) {
517 return 0 unless exists $other->{$key};
518 return 0 if $current->{$key} ne $other->{$key};
529 =head2 Unique Constraints
531 Unique indexes and constraints on the position column are not
532 supported at this time. It would be make sense to support them,
533 but there are some unexpected database issues that make this
534 hard to do. The main problem from the author's view is that
535 SQLite (the DB engine that we use for testing) does not support
538 =head2 Race Condition on Insert
540 If a position is not specified for an insert than a position
541 will be chosen based on COUNT(*)+1. But, it first selects the
542 count then inserts the record. The space of time between select
543 and insert introduces a race condition. To fix this we need the
544 ability to lock tables in DBIC. I've added an entry in the TODO
547 =head2 Multiple Moves
549 Be careful when issueing move_* methods to multiple objects. If
550 you've pre-loaded the objects then when you move one of the objects
551 the position of the other object will not reflect their new value
552 until you reload them from the database.
554 There are times when you will want to move objects as groups, such
555 as changeing the parent of several objects at once - this directly
556 conflicts with this problem. One solution is for us to write a
557 ResultSet class that supports a parent() method, for example. Another
558 solution is to somehow automagically modify the objects that exist
559 in the current object's result set to have the new position value.
563 Aran Deltac <bluefeet@cpan.org>
567 You may distribute this code under the same terms as Perl itself.