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
20 # Optional: group_id INTEGER NOT NULL
22 In your Schema or DB class add Ordered to the top
23 of the component list.
25 __PACKAGE__->load_components(qw( Ordered ... ));
27 Specify the column that stores the position number for
31 __PACKAGE__->position_column('position');
32 __PACKAGE__->grouping_column('group_id'); # optional
34 Thats it, now you can change the position of your objects.
39 my $item = My::Item->create({ name=>'Matt S. Trout' });
40 # If using grouping_column:
41 my $item = My::Item->create({ name=>'Matt S. Trout', group_id=>1 });
43 my $rs = $item->siblings();
44 my @siblings = $item->siblings();
47 $sibling = $item->first_sibling();
48 $sibling = $item->last_sibling();
49 $sibling = $item->previous_sibling();
50 $sibling = $item->next_sibling();
52 $item->move_previous();
56 $item->move_to( $position );
60 This module provides a simple interface for modifying the ordered
61 position of DBIx::Class objects.
65 All of the move_* methods automatically update the rows involved in
66 the query. This is not configurable and is due to the fact that if you
67 move a record it always causes other records in the list to be updated.
71 =head2 position_column
73 __PACKAGE__->position_column('position');
75 Sets and retrieves the name of the column that stores the
76 positional value of each record. Default to "position".
80 __PACKAGE__->mk_classdata( 'position_column' => 'position' );
82 =head2 grouping_column
84 __PACKAGE__->grouping_column('group_id');
86 This method specified a column to limit all queries in
87 this module by. This effectively allows you to have multiple
88 ordered lists within the same table.
92 __PACKAGE__->mk_classdata( 'grouping_column' );
96 my $rs = $item->siblings();
97 my @siblings = $item->siblings();
99 Returns either a result set or an array of all other objects
100 excluding the one you called it on.
106 my $position_column = $self->position_column;
107 my $rs = $self->result_source->resultset->search(
109 $position_column => { '!=' => $self->get_column($position_column) },
110 $self->_grouping_clause(),
112 { order_by => $self->position_column },
114 return $rs->all() if (wantarray());
120 my $sibling = $item->first_sibling();
122 Returns the first sibling object, or 0 if the first sibling
129 return 0 if ($self->get_column($self->position_column())==1);
130 return ($self->result_source->resultset->search(
132 $self->position_column => 1,
133 $self->_grouping_clause(),
140 my $sibling = $item->last_sibling();
142 Return the last sibling, or 0 if the last sibling is this
149 my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
150 return 0 if ($self->get_column($self->position_column())==$count);
151 return ($self->result_source->resultset->search(
153 $self->position_column => $count,
154 $self->_grouping_clause(),
159 =head2 previous_sibling
161 my $sibling = $item->previous_sibling();
163 Returns the sibling that resides one position back. Undef
164 is returned if the current object is the first one.
168 sub previous_sibling {
170 my $position_column = $self->position_column;
171 my $position = $self->get_column( $position_column );
172 return 0 if ($position==1);
173 return ($self->result_source->resultset->search(
175 $position_column => $position - 1,
176 $self->_grouping_clause(),
183 my $sibling = $item->next_sibling();
185 Returns the sibling that resides one position foward. Undef
186 is returned if the current object is the last one.
192 my $position_column = $self->position_column;
193 my $position = $self->get_column( $position_column );
194 my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
195 return 0 if ($position==$count);
196 return ($self->result_source->resultset->search(
198 $position_column => $position + 1,
199 $self->_grouping_clause(),
206 $item->move_previous();
208 Swaps position with the sibling on position previous in the list.
209 1 is returned on success, and 0 is returned if the objects is already
216 my $position = $self->get_column( $self->position_column() );
217 return $self->move_to( $position - 1 );
224 Swaps position with the sibling in the next position. 1 is returned on
225 success, and 0 is returned if the object is already the last in the list.
231 my $position = $self->get_column( $self->position_column() );
232 my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
233 return 0 if ($position==$count);
234 return $self->move_to( $position + 1 );
241 Moves the object to the first position. 1 is returned on
242 success, and 0 is returned if the object is already the first.
248 return $self->move_to( 1 );
255 Moves the object to the very last position. 1 is returned on
256 success, and 0 is returned if the object is already the last one.
262 my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
263 return $self->move_to( $count );
268 $item->move_to( $position );
270 Moves the object to the specified position. 1 is returned on
271 success, and 0 is returned if the object is already at the
277 my( $self, $to_position ) = @_;
278 my $position_column = $self->position_column;
279 my $from_position = $self->get_column( $position_column );
280 return 0 if ( $to_position < 1 );
281 return 0 if ( $from_position==$to_position );
283 ( $from_position < $to_position )
284 ? ( $from_position+1, $to_position )
285 : ( $to_position, $from_position-1 )
287 my $rs = $self->result_source->resultset->search({
288 $position_column => { -between => [ @between ] },
289 $self->_grouping_clause(),
291 my $op = ($from_position>$to_position) ? '+' : '-';
292 $rs->update({ $position_column => \"$position_column $op 1" });
293 $self->{_ORDERED_INTERNAL_UPDATE} = 1;
294 $self->update({ $position_column => $to_position });
300 $item->move_to_group( $group, $position );
302 Moves the object to the specified position of the specified
303 group, or to the end of the group if $position is undef.
304 1 is returned on success, and 0 is returned if the object is
305 already at the specified position of the specified group.
310 my( $self, $to_group, $to_position ) = @_;
311 my $position_column = $self->position_column;
312 my $grouping_column = $self->grouping_column;
314 return 0 if ( ! defined($to_group) );
315 return 0 if ( defined($to_position) and $to_position < 1 );
316 return 0 if ( $self->$grouping_column==$to_group and defined($to_position) and $self->$position_column==$to_position );
318 # Move to end of current group and adjust siblings
321 $self->$grouping_column($to_group);
322 my $new_group_count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
323 if (!defined($to_position) or $to_position > $new_group_count) {
324 $self->{_ORDERED_INTERNAL_UPDATE} = 1;
325 $self->update({ $position_column => $new_group_count + 1 });
328 my @between = ($to_position, $new_group_count);
330 my $rs = $self->result_source->resultset->search({
331 $position_column => { -between => [ @between ] },
332 $self->_grouping_clause(),
334 $rs->update({ $position_column => \"$position_column + 1" });
335 $self->{_ORDERED_INTERNAL_UPDATE} = 1;
336 $self->update({ $position_column => $to_position });
344 Overrides the DBIC insert() method by providing a default
345 position number. The default will be the number of rows in
346 the table +1, thus positioning the new record at the last position.
352 my $position_column = $self->position_column;
353 $self->set_column( $position_column => $self->result_source->resultset->search( {$self->_grouping_clause()} )->count()+1 )
354 if (!$self->get_column($position_column));
355 return $self->next::method( @_ );
360 Overrides the DBIC update() method by checking for a change
361 to the position and/or group columns. Movement within a
362 group or to another group is handled by repositioning
363 the appropriate siblings. Position defaults to the end
364 of a new group if it has been changed to undef.
371 if ($self->{_ORDERED_INTERNAL_UPDATE}) {
372 delete $self->{_ORDERED_INTERNAL_UPDATE};
373 return $self->next::method( @_ );
376 $self->set_columns($_[0]) if @_ > 0;
377 my %changes = $self->get_dirty_columns;
378 $self->discard_changes;
380 my $pos_col = $self->position_column;
381 my $grp_col = $self->grouping_column;
382 if (defined($grp_col) and exists $changes{$grp_col}) {
383 $self->move_to_group(
384 delete($changes{$grp_col}),
385 exists($changes{$pos_col}) ? delete($changes{$pos_col}) : $self->$pos_col
388 elsif (exists $changes{$pos_col}) {
389 $self->move_to(delete $changes{$pos_col});
391 return $self->next::method( \%changes );
396 Overrides the DBIC delete() method by first moving the object
397 to the last position, then deleting it, thus ensuring the
398 integrity of the positions.
405 return $self->next::method( @_ );
408 =head1 PRIVATE METHODS
410 These methods are used internally. You should never have the
413 =head2 _grouping_clause
415 This method returns a name=>value pare for limiting a search
416 by the collection column. If the collection column is not
417 defined then this will return an empty list.
421 sub _grouping_clause {
423 my $col = $self->grouping_column();
425 return ( $col => $self->get_column($col) );
435 =head2 Unique Constraints
437 Unique indexes and constraints on the position column are not
438 supported at this time. It would be make sense to support them,
439 but there are some unexpected database issues that make this
440 hard to do. The main problem from the author's view is that
441 SQLite (the DB engine that we use for testing) does not support
444 =head2 Race Condition on Insert
446 If a position is not specified for an insert than a position
447 will be chosen based on COUNT(*)+1. But, it first selects the
448 count then inserts the record. The space of time between select
449 and insert introduces a race condition. To fix this we need the
450 ability to lock tables in DBIC. I've added an entry in the TODO
453 =head2 Multiple Moves
455 Be careful when issueing move_* methods to multiple objects. If
456 you've pre-loaded the objects then when you move one of the objects
457 the position of the other object will not reflect their new value
458 until you reload them from the database.
460 There are times when you will want to move objects as groups, such
461 as changeing the parent of several objects at once - this directly
462 conflicts with this problem. One solution is for us to write a
463 ResultSet class that supports a parent() method, for example. Another
464 solution is to somehow automagically modify the objects that exist
465 in the current object's result set to have the new position value.
469 Aran Deltac <bluefeet@cpan.org>
473 You may distribute this code under the same terms as Perl itself.