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 );
282 my $rs = $self->result_source->resultset->search({
284 $position_column => { ($from_position>$to_position?'<':'>') => $from_position },
285 $position_column => { ($from_position>$to_position?'>=':'<=') => $to_position },
287 $self->_grouping_clause(),
289 my $op = ($from_position>$to_position) ? '+' : '-';
291 $position_column => \"$position_column $op 1",
293 $self->set_column( $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 pare 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 Race Condition on Insert
357 If a position is not specified for an insert than a position
358 will be chosen based on COUNT(*)+1. But, it first selects the
359 count then inserts the record. The space of time between select
360 and insert introduces a race condition. To fix this we need the
361 ability to lock tables in DBIC. I've added an entry in the TODO
364 =head2 Multiple Moves
366 Be careful when issueing move_* methods to multiple objects. If
367 you've pre-loaded the objects then when you move one of the objects
368 the position of the other object will not reflect their new value
369 until you reload them from the database.
371 The are times when you will want to move objects as groups, such
372 as changeing the parent of several objects at once - this directly
373 conflicts with this problem. One solution is for us to write a
374 ResultSet class that supports a parent() method, for example. Another
375 solution is to somehow automagically modify the objects that exist
376 in the current object's result set to have the new position value.
380 Aran Deltac <bluefeet@cpan.org>
384 You may distribute this code under the same terms as Perl itself.