1 # vim: ts=8:sw=4:sts=4:et
2 package DBIx::Class::Positioned;
5 use base qw( DBIx::Class );
9 DBIx::Class::Positioned - Modify the position of objects in an ordered list.
13 Create a table for your positionable data.
15 CREATE TABLE employees (
16 employee_id INTEGER PRIMARY KEY AUTOINCREMENT,
18 position INTEGER NOT NULL
21 In your Schema or DB class add Positioned to the top
22 of the component list.
24 __PACKAGE__->load_components(qw( Positioned ... ));
26 Specify the column that stores the position number for
30 __PACKAGE__->position_column('position');
32 Thats it, now you can change the position of your objects.
37 my $employee = My::Employee->create({ name=>'Matt S. Trout' });
39 my $rs = $employee->siblings();
40 my @siblings = $employee->siblings();
43 $sibling = $employee->first_sibling();
44 $sibling = $employee->last_sibling();
45 $sibling = $employee->previous_sibling();
46 $sibling = $employee->next_sibling();
48 $employee->move_previous();
49 $employee->move_next();
50 $employee->move_first();
51 $employee->move_last();
52 $employee->move_to( $position );
56 This module provides a simple interface for modifying the position
57 of DBIx::Class objects.
61 All of the move_* methods automatically update the rows involved in
62 the query. This is not configurable and is due to the fact that if you
63 move a record it always causes other records in the list to be updated.
67 =head2 position_column
69 __PACKAGE__->position_column('position');
71 Sets and retrieves the name of the column that stores the
72 positional value of each record. Default to "position".
76 __PACKAGE__->mk_classdata( 'position_column' => 'position' );
78 =head2 collection_column
80 __PACKAGE__->collection_column('thing_id');
82 This method specified a column to limit all queries in
83 this module by. This effectively allows you to have multiple
84 positioned lists within the same table.
88 __PACKAGE__->mk_classdata( 'collection_column' );
92 my $rs = $employee->siblings();
93 my @siblings = $employee->siblings();
95 Returns either a result set or an array of all other objects
96 excluding the one you called it on.
102 my $position_column = $self->position_column;
103 my $rs = $self->search(
105 $position_column => { '!=' => $self->get_column($position_column) },
106 $self->_collection_clause(),
108 { order_by => $self->position_column },
110 return $rs->all() if (wantarray());
116 my $sibling = $employee->first_sibling();
118 Returns the first sibling object.
124 return ($self->search(
125 { $self->_collection_clause() },
126 { rows=>1, order_by => $self->position_column },
132 my $sibling = $employee->last_sibling();
134 Return the last sibling.
140 return ($self->search(
141 { $self->_collection_clause() },
142 { rows=>1, order_by => $self->position_column.' DESC' },
146 =head2 previous_sibling
148 my $sibling = $employee->previous_sibling();
150 Returns the sibling that resides one position higher. Undef
151 is returned if the current object is the first one.
155 sub previous_sibling {
157 my $position_column = $self->position_column;
158 return ($self->search(
160 $position_column => { '<' => $self->get_column($position_column) },
161 $self->_collection_clause(),
163 { rows=>1, order_by => $position_column.' DESC' },
169 my $sibling = $employee->next_sibling();
171 Returns the sibling that resides one position lower. Undef
172 is returned if the current object is the last one.
178 my $position_column = $self->position_column;
179 return ($self->result_source->resultset->search(
181 $position_column => { '>' => $self->get_column($position_column) },
182 $self->_collection_clause(),
184 { rows=>1, order_by => $position_column },
190 $employee->move_previous();
192 Swaps position with the sibling on position previous in the list.
193 1 is returned on success, and 0 is returned if the objects is already
200 my $position = $self->get_column( $self->position_column() );
201 return $self->move_to( $position - 1 );
206 $employee->move_next();
208 Swaps position with the sibling in the next position. 1 is returned on
209 success, and 0 is returned if the object is already the last in the list.
215 my $position = $self->get_column( $self->position_column() );
216 my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
217 return 0 if ($position==$count);
218 return $self->move_to( $position + 1 );
223 $employee->move_first();
225 Moves the object to the first position. 1 is returned on
226 success, and 0 is returned if the object is already the first.
232 return $self->move_to( 1 );
237 $employee->move_last();
239 Moves the object to the very last position. 1 is returned on
240 success, and 0 is returned if the object is already the last one.
246 my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
247 return $self->move_to( $count );
252 $employee->move_to( $position );
254 Moves the object to the specified position. 1 is returned on
255 success, and 0 is returned if the object is already at the
261 my( $self, $to_position ) = @_;
262 my $position_column = $self->position_column;
263 my $from_position = $self->get_column( $position_column );
264 return 0 if ( $to_position < 1 );
265 return 0 if ( $from_position==$to_position );
266 my $rs = $self->result_source->resultset->search({
268 $position_column => { ($from_position>$to_position?'<':'>') => $from_position },
269 $position_column => { ($from_position>$to_position?'>=':'<=') => $to_position },
271 $self->_collection_clause(),
273 my $op = ($from_position>$to_position) ? '+' : '-';
275 $position_column => \"$position_column $op 1",
277 $self->set_column( $position_column => $to_position );
284 Overrides the DBIC insert() method by providing a default
285 position number. The default will be the number of rows in
286 the table +1, thus positioning the new record at the last position.
292 my $position_column = $self->position_column;
293 $self->set_column( $position_column => $self->result_source->resultset->search( {$self->_collection_clause()} )->count()+1 )
294 if (!$self->get_column($position_column));
295 $self->next::method( @_ );
300 Overrides the DBIC delete() method by first moving the object
301 to the last position, then deleting it, thus ensuring the
302 integrity of the positions.
309 $self->next::method( @_ );
312 =head1 PRIVATE METHODS
314 These methods are used internally. You should never have the
317 =head2 _collection_clause
319 This method returns a name=>value pare for limiting a search
320 by the collection column. If the collection column is not
321 defined then this will return an empty list.
325 sub _collection_clause {
327 if ($self->collection_column()) {
328 return ( $self->collection_column() => $self->get_column($self->collection_column()) );
338 =head2 Race Condition on Insert
340 If a position is not specified for an insert than a position
341 will be chosen based on COUNT(*)+1. But, it first selects the
342 count then inserts the record. The space of time between select
343 and insert introduces a race condition. To fix this we need the
344 ability to lock tables in DBIC. I've added an entry in the TODO
347 =head2 Multiple Moves
349 Be careful when issueing move_* methods to multiple objects. If
350 you've pre-loaded the objects then when you move one of the objects
351 the position of the other object will not reflect their new value
352 until you reload them from the database.
354 The are times when you will want to move objects as groups, such
355 as changeing the parent of several objects at once - this directly
356 conflicts with this problem. One solution is for us to write a
357 ResultSet class that supports a parent() method, for example. Another
358 solution is to somehow automagically modify the objects that exist
359 in the current object's result set to have the new position value.
363 Aran Deltac <bluefeet@cpan.org>
367 You may distribute this code under the same terms as Perl itself.