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 my $position = $self->get_column( $position_column );
159 return 0 if ($position==1);
160 return ($self->result_source->resultset->search(
162 $position_column => $position - 1,
163 $self->_collection_clause(),
170 my $sibling = $employee->next_sibling();
172 Returns the sibling that resides one position lower. Undef
173 is returned if the current object is the last one.
179 my $position_column = $self->position_column;
180 my $position = $self->get_column( $position_column );
181 my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
182 return 0 if ($position==$count);
183 return ($self->result_source->resultset->search(
185 $position_column => $position + 1,
186 $self->_collection_clause(),
193 $employee->move_previous();
195 Swaps position with the sibling on position previous in the list.
196 1 is returned on success, and 0 is returned if the objects is already
203 my $position = $self->get_column( $self->position_column() );
204 return $self->move_to( $position - 1 );
209 $employee->move_next();
211 Swaps position with the sibling in the next position. 1 is returned on
212 success, and 0 is returned if the object is already the last in the list.
218 my $position = $self->get_column( $self->position_column() );
219 my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
220 return 0 if ($position==$count);
221 return $self->move_to( $position + 1 );
226 $employee->move_first();
228 Moves the object to the first position. 1 is returned on
229 success, and 0 is returned if the object is already the first.
235 return $self->move_to( 1 );
240 $employee->move_last();
242 Moves the object to the very last position. 1 is returned on
243 success, and 0 is returned if the object is already the last one.
249 my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
250 return $self->move_to( $count );
255 $employee->move_to( $position );
257 Moves the object to the specified position. 1 is returned on
258 success, and 0 is returned if the object is already at the
264 my( $self, $to_position ) = @_;
265 my $position_column = $self->position_column;
266 my $from_position = $self->get_column( $position_column );
267 return 0 if ( $to_position < 1 );
268 return 0 if ( $from_position==$to_position );
269 my $rs = $self->result_source->resultset->search({
271 $position_column => { ($from_position>$to_position?'<':'>') => $from_position },
272 $position_column => { ($from_position>$to_position?'>=':'<=') => $to_position },
274 $self->_collection_clause(),
276 my $op = ($from_position>$to_position) ? '+' : '-';
278 $position_column => \"$position_column $op 1",
280 $self->set_column( $position_column => $to_position );
287 Overrides the DBIC insert() method by providing a default
288 position number. The default will be the number of rows in
289 the table +1, thus positioning the new record at the last position.
295 my $position_column = $self->position_column;
296 $self->set_column( $position_column => $self->result_source->resultset->search( {$self->_collection_clause()} )->count()+1 )
297 if (!$self->get_column($position_column));
298 $self->next::method( @_ );
303 Overrides the DBIC delete() method by first moving the object
304 to the last position, then deleting it, thus ensuring the
305 integrity of the positions.
312 $self->next::method( @_ );
315 =head1 PRIVATE METHODS
317 These methods are used internally. You should never have the
320 =head2 _collection_clause
322 This method returns a name=>value pare for limiting a search
323 by the collection column. If the collection column is not
324 defined then this will return an empty list.
328 sub _collection_clause {
330 if ($self->collection_column()) {
331 return ( $self->collection_column() => $self->get_column($self->collection_column()) );
341 =head2 Race Condition on Insert
343 If a position is not specified for an insert than a position
344 will be chosen based on COUNT(*)+1. But, it first selects the
345 count then inserts the record. The space of time between select
346 and insert introduces a race condition. To fix this we need the
347 ability to lock tables in DBIC. I've added an entry in the TODO
350 =head2 Multiple Moves
352 Be careful when issueing move_* methods to multiple objects. If
353 you've pre-loaded the objects then when you move one of the objects
354 the position of the other object will not reflect their new value
355 until you reload them from the database.
357 The are times when you will want to move objects as groups, such
358 as changeing the parent of several objects at once - this directly
359 conflicts with this problem. One solution is for us to write a
360 ResultSet class that supports a parent() method, for example. Another
361 solution is to somehow automagically modify the objects that exist
362 in the current object's result set to have the new position value.
366 Aran Deltac <bluefeet@cpan.org>
370 You may distribute this code under the same terms as Perl itself.