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->result_source->resultset->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, or 0 if the first sibling
125 return 0 if ($self->get_column($self->position_column())==1);
126 return ($self->result_source->resultset->search(
128 $self->position_column => 1,
129 $self->_collection_clause(),
136 my $sibling = $employee->last_sibling();
138 Return the last sibling, or 0 if the last sibling is this
145 my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
146 return 0 if ($self->get_column($self->position_column())==$count);
147 return ($self->result_source->resultset->search(
149 $self->position_column => $count,
150 $self->_collection_clause(),
155 =head2 previous_sibling
157 my $sibling = $employee->previous_sibling();
159 Returns the sibling that resides one position higher. Undef
160 is returned if the current object is the first one.
164 sub previous_sibling {
166 my $position_column = $self->position_column;
167 my $position = $self->get_column( $position_column );
168 return 0 if ($position==1);
169 return ($self->result_source->resultset->search(
171 $position_column => $position - 1,
172 $self->_collection_clause(),
179 my $sibling = $employee->next_sibling();
181 Returns the sibling that resides one position lower. Undef
182 is returned if the current object is the last one.
188 my $position_column = $self->position_column;
189 my $position = $self->get_column( $position_column );
190 my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
191 return 0 if ($position==$count);
192 return ($self->result_source->resultset->search(
194 $position_column => $position + 1,
195 $self->_collection_clause(),
202 $employee->move_previous();
204 Swaps position with the sibling on position previous in the list.
205 1 is returned on success, and 0 is returned if the objects is already
212 my $position = $self->get_column( $self->position_column() );
213 return $self->move_to( $position - 1 );
218 $employee->move_next();
220 Swaps position with the sibling in the next position. 1 is returned on
221 success, and 0 is returned if the object is already the last in the list.
227 my $position = $self->get_column( $self->position_column() );
228 my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
229 return 0 if ($position==$count);
230 return $self->move_to( $position + 1 );
235 $employee->move_first();
237 Moves the object to the first position. 1 is returned on
238 success, and 0 is returned if the object is already the first.
244 return $self->move_to( 1 );
249 $employee->move_last();
251 Moves the object to the very last position. 1 is returned on
252 success, and 0 is returned if the object is already the last one.
258 my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
259 return $self->move_to( $count );
264 $employee->move_to( $position );
266 Moves the object to the specified position. 1 is returned on
267 success, and 0 is returned if the object is already at the
273 my( $self, $to_position ) = @_;
274 my $position_column = $self->position_column;
275 my $from_position = $self->get_column( $position_column );
276 return 0 if ( $to_position < 1 );
277 return 0 if ( $from_position==$to_position );
278 my $rs = $self->result_source->resultset->search({
280 $position_column => { ($from_position>$to_position?'<':'>') => $from_position },
281 $position_column => { ($from_position>$to_position?'>=':'<=') => $to_position },
283 $self->_collection_clause(),
285 my $op = ($from_position>$to_position) ? '+' : '-';
287 $position_column => \"$position_column $op 1",
289 $self->set_column( $position_column => $to_position );
296 Overrides the DBIC insert() method by providing a default
297 position number. The default will be the number of rows in
298 the table +1, thus positioning the new record at the last position.
304 my $position_column = $self->position_column;
305 $self->set_column( $position_column => $self->result_source->resultset->search( {$self->_collection_clause()} )->count()+1 )
306 if (!$self->get_column($position_column));
307 $self->next::method( @_ );
312 Overrides the DBIC delete() method by first moving the object
313 to the last position, then deleting it, thus ensuring the
314 integrity of the positions.
321 $self->next::method( @_ );
324 =head1 PRIVATE METHODS
326 These methods are used internally. You should never have the
329 =head2 _collection_clause
331 This method returns a name=>value pare for limiting a search
332 by the collection column. If the collection column is not
333 defined then this will return an empty list.
337 sub _collection_clause {
339 if ($self->collection_column()) {
340 return ( $self->collection_column() => $self->get_column($self->collection_column()) );
350 =head2 Race Condition on Insert
352 If a position is not specified for an insert than a position
353 will be chosen based on COUNT(*)+1. But, it first selects the
354 count then inserts the record. The space of time between select
355 and insert introduces a race condition. To fix this we need the
356 ability to lock tables in DBIC. I've added an entry in the TODO
359 =head2 Multiple Moves
361 Be careful when issueing move_* methods to multiple objects. If
362 you've pre-loaded the objects then when you move one of the objects
363 the position of the other object will not reflect their new value
364 until you reload them from the database.
366 The are times when you will want to move objects as groups, such
367 as changeing the parent of several objects at once - this directly
368 conflicts with this problem. One solution is for us to write a
369 ResultSet class that supports a parent() method, for example. Another
370 solution is to somehow automagically modify the objects that exist
371 in the current object's result set to have the new position value.
375 Aran Deltac <bluefeet@cpan.org>
379 You may distribute this code under the same terms as Perl itself.