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 That's 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. Defaults to "position".
80 __PACKAGE__->mk_classdata( 'position_column' => 'position' );
82 =head2 grouping_column
84 __PACKAGE__->grouping_column('group_id');
86 This method specifies 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 resultset 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 Returns 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. Returns undef
164 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 forward. Returns undef
186 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 in the position previous in
209 the list. Returns 1 on success, and 0 if the object is
210 already the first one.
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 in the
225 list. Returns 1 on success, and 0 if the object is already
226 the last in the list.
232 my $position = $self->get_column( $self->position_column() );
233 my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
234 return 0 if ($position==$count);
235 return $self->move_to( $position + 1 );
242 Moves the object to the first position in the list. Returns 1
243 on success, and 0 if the object is already the first.
249 return $self->move_to( 1 );
256 Moves the object to the last position in the list. Returns 1
257 on success, and 0 if the object is already the last one.
263 my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
264 return $self->move_to( $count );
269 $item->move_to( $position );
271 Moves the object to the specified position. Returns 1 on
272 success, and 0 if the object is already at the specified
278 my( $self, $to_position ) = @_;
279 my $position_column = $self->position_column;
280 my $from_position = $self->get_column( $position_column );
281 return 0 if ( $to_position < 1 );
282 return 0 if ( $from_position==$to_position );
284 ( $from_position < $to_position )
285 ? ( $from_position+1, $to_position )
286 : ( $to_position, $from_position-1 )
288 my $rs = $self->result_source->resultset->search({
289 $position_column => { -between => [ @between ] },
290 $self->_grouping_clause(),
292 my $op = ($from_position>$to_position) ? '+' : '-';
293 $rs->update({ $position_column => \"$position_column $op 1" });
294 $self->update({ $position_column => $to_position });
300 Overrides the DBIC insert() method by providing a default
301 position number. The default will be the number of rows in
302 the table +1, thus positioning the new record at the last position.
308 my $position_column = $self->position_column;
309 $self->set_column( $position_column => $self->result_source->resultset->search( {$self->_grouping_clause()} )->count()+1 )
310 if (!$self->get_column($position_column));
311 return $self->next::method( @_ );
316 Overrides the DBIC delete() method by first moving the object
317 to the last position, then deleting it, thus ensuring the
318 integrity of the positions.
325 return $self->next::method( @_ );
328 =head1 PRIVATE METHODS
330 These methods are used internally. You should never have the
333 =head2 _grouping_clause
335 This method returns a name=>value pair for limiting a search
336 by the collection column. If the collection column is not
337 defined then this will return an empty list.
341 sub _grouping_clause {
343 my $col = $self->grouping_column();
345 return ( $col => $self->get_column($col) );
355 =head2 Unique Constraints
357 Unique indexes and constraints on the position column are not
358 supported at this time. It would be make sense to support them,
359 but there are some unexpected database issues that make this
360 hard to do. The main problem from the author's view is that
361 SQLite (the DB engine that we use for testing) does not support
364 =head2 Race Condition on Insert
366 If a position is not specified for an insert than a position
367 will be chosen based on COUNT(*)+1. But, it first selects the
368 count, and then inserts the record. The space of time between select
369 and insert introduces a race condition. To fix this we need the
370 ability to lock tables in DBIC. I've added an entry in the TODO
373 =head2 Multiple Moves
375 Be careful when issueing move_* methods to multiple objects. If
376 you've pre-loaded the objects then when you move one of the objects
377 the position of the other object will not reflect their new value
378 until you reload them from the database.
380 There are times when you will want to move objects as groups, such
381 as changeing the parent of several objects at once - this directly
382 conflicts with this problem. One solution is for us to write a
383 ResultSet class that supports a parent() method, for example. Another
384 solution is to somehow automagically modify the objects that exist
385 in the current object's result set to have the new position value.
389 Aran Deltac <bluefeet@cpan.org>
393 You may distribute this code under the same terms as Perl itself.