Commit | Line | Data |
118e6b96 |
1 | # vim: ts=8:sw=4:sts=4:et |
a733c37f |
2 | package DBIx::Class::Ordered; |
118e6b96 |
3 | use strict; |
4 | use warnings; |
5 | use base qw( DBIx::Class ); |
6 | |
7 | =head1 NAME |
8 | |
a733c37f |
9 | DBIx::Class::Ordered - Modify the position of objects in an ordered list. |
118e6b96 |
10 | |
11 | =head1 SYNOPSIS |
12 | |
a733c37f |
13 | Create a table for your ordered data. |
118e6b96 |
14 | |
a733c37f |
15 | CREATE TABLE items ( |
16 | item_id INTEGER PRIMARY KEY AUTOINCREMENT, |
118e6b96 |
17 | name TEXT NOT NULL, |
18 | position INTEGER NOT NULL |
19 | ); |
169bb185 |
20 | # Optional: group_id INTEGER NOT NULL |
118e6b96 |
21 | |
a733c37f |
22 | In your Schema or DB class add Ordered to the top |
118e6b96 |
23 | of the component list. |
24 | |
a733c37f |
25 | __PACKAGE__->load_components(qw( Ordered ... )); |
118e6b96 |
26 | |
27 | Specify the column that stores the position number for |
28 | each row. |
29 | |
a733c37f |
30 | package My::Item; |
118e6b96 |
31 | __PACKAGE__->position_column('position'); |
a733c37f |
32 | __PACKAGE__->grouping_column('group_id'); # optional |
118e6b96 |
33 | |
34 | Thats it, now you can change the position of your objects. |
35 | |
36 | #!/use/bin/perl |
a733c37f |
37 | use My::Item; |
118e6b96 |
38 | |
a733c37f |
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 }); |
118e6b96 |
42 | |
a733c37f |
43 | my $rs = $item->siblings(); |
44 | my @siblings = $item->siblings(); |
118e6b96 |
45 | |
46 | my $sibling; |
a733c37f |
47 | $sibling = $item->first_sibling(); |
48 | $sibling = $item->last_sibling(); |
49 | $sibling = $item->previous_sibling(); |
50 | $sibling = $item->next_sibling(); |
118e6b96 |
51 | |
a733c37f |
52 | $item->move_previous(); |
53 | $item->move_next(); |
54 | $item->move_first(); |
55 | $item->move_last(); |
56 | $item->move_to( $position ); |
118e6b96 |
57 | |
58 | =head1 DESCRIPTION |
59 | |
a733c37f |
60 | This module provides a simple interface for modifying the ordered |
61 | position of DBIx::Class objects. |
118e6b96 |
62 | |
133dd22a |
63 | =head1 AUTO UPDATE |
64 | |
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. |
68 | |
118e6b96 |
69 | =head1 METHODS |
70 | |
71 | =head2 position_column |
72 | |
73 | __PACKAGE__->position_column('position'); |
74 | |
75 | Sets and retrieves the name of the column that stores the |
76 | positional value of each record. Default to "position". |
77 | |
78 | =cut |
79 | |
80 | __PACKAGE__->mk_classdata( 'position_column' => 'position' ); |
81 | |
a733c37f |
82 | =head2 grouping_column |
133dd22a |
83 | |
a733c37f |
84 | __PACKAGE__->grouping_column('group_id'); |
133dd22a |
85 | |
86 | This method specified a column to limit all queries in |
87 | this module by. This effectively allows you to have multiple |
a733c37f |
88 | ordered lists within the same table. |
133dd22a |
89 | |
90 | =cut |
91 | |
a733c37f |
92 | __PACKAGE__->mk_classdata( 'grouping_column' ); |
133dd22a |
93 | |
118e6b96 |
94 | =head2 siblings |
95 | |
a733c37f |
96 | my $rs = $item->siblings(); |
97 | my @siblings = $item->siblings(); |
118e6b96 |
98 | |
99 | Returns either a result set or an array of all other objects |
100 | excluding the one you called it on. |
101 | |
102 | =cut |
103 | |
104 | sub siblings { |
105 | my( $self ) = @_; |
106 | my $position_column = $self->position_column; |
a9cdbec2 |
107 | my $rs = $self->result_source->resultset->search( |
7a76f44c |
108 | { |
109 | $position_column => { '!=' => $self->get_column($position_column) }, |
a733c37f |
110 | $self->_grouping_clause(), |
7a76f44c |
111 | }, |
118e6b96 |
112 | { order_by => $self->position_column }, |
113 | ); |
7a76f44c |
114 | return $rs->all() if (wantarray()); |
115 | return $rs; |
118e6b96 |
116 | } |
117 | |
118 | =head2 first_sibling |
119 | |
a733c37f |
120 | my $sibling = $item->first_sibling(); |
118e6b96 |
121 | |
5faa95af |
122 | Returns the first sibling object, or 0 if the first sibling |
123 | is this sibliing. |
118e6b96 |
124 | |
125 | =cut |
126 | |
127 | sub first_sibling { |
128 | my( $self ) = @_; |
5faa95af |
129 | return 0 if ($self->get_column($self->position_column())==1); |
a9cdbec2 |
130 | return ($self->result_source->resultset->search( |
131 | { |
132 | $self->position_column => 1, |
a733c37f |
133 | $self->_grouping_clause(), |
a9cdbec2 |
134 | }, |
118e6b96 |
135 | )->all())[0]; |
136 | } |
137 | |
138 | =head2 last_sibling |
139 | |
a733c37f |
140 | my $sibling = $item->last_sibling(); |
118e6b96 |
141 | |
5faa95af |
142 | Return the last sibling, or 0 if the last sibling is this |
143 | sibling. |
118e6b96 |
144 | |
145 | =cut |
146 | |
147 | sub last_sibling { |
148 | my( $self ) = @_; |
a733c37f |
149 | my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count(); |
5faa95af |
150 | return 0 if ($self->get_column($self->position_column())==$count); |
a9cdbec2 |
151 | return ($self->result_source->resultset->search( |
152 | { |
153 | $self->position_column => $count, |
a733c37f |
154 | $self->_grouping_clause(), |
a9cdbec2 |
155 | }, |
118e6b96 |
156 | )->all())[0]; |
157 | } |
158 | |
159 | =head2 previous_sibling |
160 | |
a733c37f |
161 | my $sibling = $item->previous_sibling(); |
118e6b96 |
162 | |
a733c37f |
163 | Returns the sibling that resides one position back. Undef |
118e6b96 |
164 | is returned if the current object is the first one. |
165 | |
166 | =cut |
167 | |
168 | sub previous_sibling { |
169 | my( $self ) = @_; |
170 | my $position_column = $self->position_column; |
707cbb2d |
171 | my $position = $self->get_column( $position_column ); |
172 | return 0 if ($position==1); |
3ffca97b |
173 | return ($self->result_source->resultset->search( |
7a76f44c |
174 | { |
707cbb2d |
175 | $position_column => $position - 1, |
a733c37f |
176 | $self->_grouping_clause(), |
707cbb2d |
177 | } |
118e6b96 |
178 | )->all())[0]; |
179 | } |
180 | |
181 | =head2 next_sibling |
182 | |
a733c37f |
183 | my $sibling = $item->next_sibling(); |
118e6b96 |
184 | |
a733c37f |
185 | Returns the sibling that resides one position foward. Undef |
118e6b96 |
186 | is returned if the current object is the last one. |
187 | |
188 | =cut |
189 | |
190 | sub next_sibling { |
191 | my( $self ) = @_; |
192 | my $position_column = $self->position_column; |
707cbb2d |
193 | my $position = $self->get_column( $position_column ); |
a733c37f |
194 | my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count(); |
707cbb2d |
195 | return 0 if ($position==$count); |
133dd22a |
196 | return ($self->result_source->resultset->search( |
7a76f44c |
197 | { |
707cbb2d |
198 | $position_column => $position + 1, |
a733c37f |
199 | $self->_grouping_clause(), |
7a76f44c |
200 | }, |
118e6b96 |
201 | )->all())[0]; |
202 | } |
203 | |
80010e2b |
204 | =head2 move_previous |
118e6b96 |
205 | |
a733c37f |
206 | $item->move_previous(); |
118e6b96 |
207 | |
80010e2b |
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 |
210 | the first one. |
118e6b96 |
211 | |
212 | =cut |
213 | |
80010e2b |
214 | sub move_previous { |
118e6b96 |
215 | my( $self ) = @_; |
133dd22a |
216 | my $position = $self->get_column( $self->position_column() ); |
217 | return $self->move_to( $position - 1 ); |
118e6b96 |
218 | } |
219 | |
80010e2b |
220 | =head2 move_next |
118e6b96 |
221 | |
a733c37f |
222 | $item->move_next(); |
118e6b96 |
223 | |
80010e2b |
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. |
118e6b96 |
226 | |
227 | =cut |
228 | |
80010e2b |
229 | sub move_next { |
118e6b96 |
230 | my( $self ) = @_; |
133dd22a |
231 | my $position = $self->get_column( $self->position_column() ); |
a733c37f |
232 | my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count(); |
133dd22a |
233 | return 0 if ($position==$count); |
234 | return $self->move_to( $position + 1 ); |
118e6b96 |
235 | } |
236 | |
237 | =head2 move_first |
238 | |
a733c37f |
239 | $item->move_first(); |
118e6b96 |
240 | |
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. |
243 | |
244 | =cut |
245 | |
246 | sub move_first { |
247 | my( $self ) = @_; |
248 | return $self->move_to( 1 ); |
249 | } |
250 | |
251 | =head2 move_last |
252 | |
a733c37f |
253 | $item->move_last(); |
118e6b96 |
254 | |
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. |
257 | |
258 | =cut |
259 | |
260 | sub move_last { |
261 | my( $self ) = @_; |
a733c37f |
262 | my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count(); |
118e6b96 |
263 | return $self->move_to( $count ); |
264 | } |
265 | |
266 | =head2 move_to |
267 | |
a733c37f |
268 | $item->move_to( $position ); |
118e6b96 |
269 | |
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 |
272 | specified position. |
273 | |
274 | =cut |
275 | |
276 | sub move_to { |
277 | my( $self, $to_position ) = @_; |
278 | my $position_column = $self->position_column; |
279 | my $from_position = $self->get_column( $position_column ); |
133dd22a |
280 | return 0 if ( $to_position < 1 ); |
281 | return 0 if ( $from_position==$to_position ); |
dc66dea1 |
282 | my @between = ( |
283 | ( $from_position < $to_position ) |
284 | ? ( $from_position+1, $to_position ) |
285 | : ( $to_position, $from_position-1 ) |
286 | ); |
133dd22a |
287 | my $rs = $self->result_source->resultset->search({ |
dc66dea1 |
288 | $position_column => { -between => [ @between ] }, |
a733c37f |
289 | $self->_grouping_clause(), |
118e6b96 |
290 | }); |
291 | my $op = ($from_position>$to_position) ? '+' : '-'; |
b1c66eea |
292 | $rs->update({ $position_column => \"$position_column $op 1" }); |
79dc353a |
293 | $self->{_ORDERED_INTERNAL_UPDATE} = 1; |
b1c66eea |
294 | $self->update({ $position_column => $to_position }); |
118e6b96 |
295 | return 1; |
296 | } |
297 | |
79dc353a |
298 | =head2 move_to_group |
299 | |
300 | $item->move_to_group( $group, $position ); |
301 | |
302 | Moves the object to the specified position of the specified |
303 | group, or to the end of the group if $position is undef. |
304 | 1 is returned on success, and 0 is returned if the object is |
305 | already at the specified position of the specified group. |
306 | |
307 | =cut |
308 | |
309 | sub move_to_group { |
310 | my( $self, $to_group, $to_position ) = @_; |
311 | my $position_column = $self->position_column; |
312 | my $grouping_column = $self->grouping_column; |
313 | |
314 | return 0 if ( ! defined($to_group) ); |
315 | return 0 if ( defined($to_position) and $to_position < 1 ); |
316 | return 0 if ( $self->$grouping_column==$to_group and defined($to_position) and $self->$position_column==$to_position ); |
317 | |
318 | # Move to end of current group and adjust siblings |
319 | $self->move_last; |
320 | |
321 | $self->$grouping_column($to_group); |
322 | my $new_group_count = $self->result_source->resultset->search({$self->_grouping_clause()})->count(); |
323 | if (!defined($to_position) or $to_position > $new_group_count) { |
324 | $self->{_ORDERED_INTERNAL_UPDATE} = 1; |
325 | $self->update({ $position_column => $new_group_count + 1 }); |
326 | } |
327 | else { |
328 | my @between = ($to_position, $new_group_count); |
329 | |
330 | my $rs = $self->result_source->resultset->search({ |
331 | $position_column => { -between => [ @between ] }, |
332 | $self->_grouping_clause(), |
333 | }); |
334 | $rs->update({ $position_column => \"$position_column + 1" }); |
335 | $self->{_ORDERED_INTERNAL_UPDATE} = 1; |
336 | $self->update({ $position_column => $to_position }); |
337 | } |
338 | |
339 | return 1; |
340 | } |
341 | |
118e6b96 |
342 | =head2 insert |
343 | |
344 | Overrides the DBIC insert() method by providing a default |
345 | position number. The default will be the number of rows in |
346 | the table +1, thus positioning the new record at the last position. |
347 | |
348 | =cut |
349 | |
350 | sub insert { |
351 | my $self = shift; |
352 | my $position_column = $self->position_column; |
a733c37f |
353 | $self->set_column( $position_column => $self->result_source->resultset->search( {$self->_grouping_clause()} )->count()+1 ) |
118e6b96 |
354 | if (!$self->get_column($position_column)); |
0a298c73 |
355 | return $self->next::method( @_ ); |
118e6b96 |
356 | } |
357 | |
79dc353a |
358 | =head2 update |
359 | |
360 | Overrides the DBIC update() method by checking for a change |
361 | to the position and/or group columns. Movement within a |
362 | group or to another group is handled by repositioning |
363 | the appropriate siblings. Position defaults to the end |
364 | of a new group if it has been changed to undef. |
365 | |
366 | =cut |
367 | |
368 | sub update { |
369 | my $self = shift; |
370 | |
371 | if ($self->{_ORDERED_INTERNAL_UPDATE}) { |
372 | delete $self->{_ORDERED_INTERNAL_UPDATE}; |
373 | return $self->next::method( @_ ); |
374 | } |
375 | |
376 | $self->set_columns($_[0]) if @_ > 0; |
377 | my %changes = $self->get_dirty_columns; |
378 | $self->discard_changes; |
379 | |
380 | my $pos_col = $self->position_column; |
381 | my $grp_col = $self->grouping_column; |
382 | if (defined($grp_col) and exists $changes{$grp_col}) { |
383 | $self->move_to_group( |
384 | delete($changes{$grp_col}), |
385 | exists($changes{$pos_col}) ? delete($changes{$pos_col}) : $self->$pos_col |
386 | ); |
387 | } |
388 | elsif (exists $changes{$pos_col}) { |
389 | $self->move_to(delete $changes{$pos_col}); |
390 | } |
391 | return $self->next::method( \%changes ); |
392 | } |
393 | |
118e6b96 |
394 | =head2 delete |
395 | |
396 | Overrides the DBIC delete() method by first moving the object |
397 | to the last position, then deleting it, thus ensuring the |
398 | integrity of the positions. |
399 | |
400 | =cut |
401 | |
402 | sub delete { |
403 | my $self = shift; |
404 | $self->move_last; |
0a298c73 |
405 | return $self->next::method( @_ ); |
118e6b96 |
406 | } |
407 | |
7a76f44c |
408 | =head1 PRIVATE METHODS |
409 | |
410 | These methods are used internally. You should never have the |
411 | need to use them. |
412 | |
a733c37f |
413 | =head2 _grouping_clause |
118e6b96 |
414 | |
133dd22a |
415 | This method returns a name=>value pare for limiting a search |
416 | by the collection column. If the collection column is not |
417 | defined then this will return an empty list. |
118e6b96 |
418 | |
7a76f44c |
419 | =cut |
420 | |
a733c37f |
421 | sub _grouping_clause { |
169bb185 |
422 | my( $self ) = @_; |
a733c37f |
423 | my $col = $self->grouping_column(); |
424 | if ($col) { |
425 | return ( $col => $self->get_column($col) ); |
133dd22a |
426 | } |
7a76f44c |
427 | return (); |
428 | } |
429 | |
430 | 1; |
431 | __END__ |
118e6b96 |
432 | |
433 | =head1 BUGS |
434 | |
dc66dea1 |
435 | =head2 Unique Constraints |
436 | |
437 | Unique indexes and constraints on the position column are not |
438 | supported at this time. It would be make sense to support them, |
439 | but there are some unexpected database issues that make this |
440 | hard to do. The main problem from the author's view is that |
441 | SQLite (the DB engine that we use for testing) does not support |
442 | ORDER BY on updates. |
443 | |
133dd22a |
444 | =head2 Race Condition on Insert |
445 | |
118e6b96 |
446 | If a position is not specified for an insert than a position |
447 | will be chosen based on COUNT(*)+1. But, it first selects the |
448 | count then inserts the record. The space of time between select |
449 | and insert introduces a race condition. To fix this we need the |
450 | ability to lock tables in DBIC. I've added an entry in the TODO |
451 | about this. |
452 | |
133dd22a |
453 | =head2 Multiple Moves |
454 | |
455 | Be careful when issueing move_* methods to multiple objects. If |
456 | you've pre-loaded the objects then when you move one of the objects |
457 | the position of the other object will not reflect their new value |
458 | until you reload them from the database. |
459 | |
dc66dea1 |
460 | There are times when you will want to move objects as groups, such |
133dd22a |
461 | as changeing the parent of several objects at once - this directly |
462 | conflicts with this problem. One solution is for us to write a |
463 | ResultSet class that supports a parent() method, for example. Another |
464 | solution is to somehow automagically modify the objects that exist |
465 | in the current object's result set to have the new position value. |
466 | |
118e6b96 |
467 | =head1 AUTHOR |
468 | |
469 | Aran Deltac <bluefeet@cpan.org> |
470 | |
471 | =head1 LICENSE |
472 | |
473 | You may distribute this code under the same terms as Perl itself. |
474 | |