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 | ); |
1d941d67 |
20 | |
e9188247 |
21 | Optionally, add one or more columns to specify groupings, allowing you |
22 | to maintain independent ordered lists within one table: |
23 | |
24 | CREATE TABLE items ( |
25 | item_id INTEGER PRIMARY KEY AUTOINCREMENT, |
26 | name TEXT NOT NULL, |
27 | position INTEGER NOT NULL, |
28 | group_id INTEGER NOT NULL |
29 | ); |
30 | |
31 | Or even |
32 | |
33 | CREATE TABLE items ( |
34 | item_id INTEGER PRIMARY KEY AUTOINCREMENT, |
35 | name TEXT NOT NULL, |
36 | position INTEGER NOT NULL, |
37 | group_id INTEGER NOT NULL, |
38 | other_group_id INTEGER NOT NULL |
39 | ); |
40 | |
41 | In your Schema or DB class add Ordered to the top |
118e6b96 |
42 | of the component list. |
43 | |
a733c37f |
44 | __PACKAGE__->load_components(qw( Ordered ... )); |
118e6b96 |
45 | |
46 | Specify the column that stores the position number for |
47 | each row. |
48 | |
a733c37f |
49 | package My::Item; |
118e6b96 |
50 | __PACKAGE__->position_column('position'); |
1d941d67 |
51 | |
e9188247 |
52 | If you are using one grouping column, specify it as follows: |
53 | |
54 | __PACKAGE__->grouping_column('group_id'); |
55 | |
56 | Or if you have multiple grouping columns: |
57 | |
58 | __PACKAGE__->grouping_column(['group_id', 'other_group_id']); |
59 | |
60 | Thats it, now you can change the position of your objects. |
118e6b96 |
61 | |
62 | #!/use/bin/perl |
a733c37f |
63 | use My::Item; |
118e6b96 |
64 | |
a733c37f |
65 | my $item = My::Item->create({ name=>'Matt S. Trout' }); |
66 | # If using grouping_column: |
67 | my $item = My::Item->create({ name=>'Matt S. Trout', group_id=>1 }); |
118e6b96 |
68 | |
a733c37f |
69 | my $rs = $item->siblings(); |
70 | my @siblings = $item->siblings(); |
118e6b96 |
71 | |
72 | my $sibling; |
a733c37f |
73 | $sibling = $item->first_sibling(); |
74 | $sibling = $item->last_sibling(); |
75 | $sibling = $item->previous_sibling(); |
76 | $sibling = $item->next_sibling(); |
118e6b96 |
77 | |
a733c37f |
78 | $item->move_previous(); |
79 | $item->move_next(); |
80 | $item->move_first(); |
81 | $item->move_last(); |
82 | $item->move_to( $position ); |
1d941d67 |
83 | $item->move_to_group( 'groupname' ); |
84 | $item->move_to_group( 'groupname', $position ); |
85 | $item->move_to_group( {group_id=>'groupname', 'other_group_id=>'othergroupname'} ); |
86 | $item->move_to_group( {group_id=>'groupname', 'other_group_id=>'othergroupname'}, $position ); |
118e6b96 |
87 | |
88 | =head1 DESCRIPTION |
89 | |
a733c37f |
90 | This module provides a simple interface for modifying the ordered |
91 | position of DBIx::Class objects. |
118e6b96 |
92 | |
133dd22a |
93 | =head1 AUTO UPDATE |
94 | |
95 | All of the move_* methods automatically update the rows involved in |
96 | the query. This is not configurable and is due to the fact that if you |
97 | move a record it always causes other records in the list to be updated. |
98 | |
118e6b96 |
99 | =head1 METHODS |
100 | |
101 | =head2 position_column |
102 | |
103 | __PACKAGE__->position_column('position'); |
104 | |
105 | Sets and retrieves the name of the column that stores the |
e9188247 |
106 | positional value of each record. Default to "position". |
118e6b96 |
107 | |
108 | =cut |
109 | |
110 | __PACKAGE__->mk_classdata( 'position_column' => 'position' ); |
111 | |
a733c37f |
112 | =head2 grouping_column |
133dd22a |
113 | |
a733c37f |
114 | __PACKAGE__->grouping_column('group_id'); |
133dd22a |
115 | |
e9188247 |
116 | This method specified a column to limit all queries in |
133dd22a |
117 | this module by. This effectively allows you to have multiple |
a733c37f |
118 | ordered lists within the same table. |
133dd22a |
119 | |
120 | =cut |
121 | |
a733c37f |
122 | __PACKAGE__->mk_classdata( 'grouping_column' ); |
133dd22a |
123 | |
118e6b96 |
124 | =head2 siblings |
125 | |
a733c37f |
126 | my $rs = $item->siblings(); |
127 | my @siblings = $item->siblings(); |
118e6b96 |
128 | |
e9188247 |
129 | Returns either a result set or an array of all other objects |
118e6b96 |
130 | excluding the one you called it on. |
131 | |
132 | =cut |
133 | |
134 | sub siblings { |
135 | my( $self ) = @_; |
136 | my $position_column = $self->position_column; |
a9cdbec2 |
137 | my $rs = $self->result_source->resultset->search( |
7a76f44c |
138 | { |
139 | $position_column => { '!=' => $self->get_column($position_column) }, |
a733c37f |
140 | $self->_grouping_clause(), |
7a76f44c |
141 | }, |
118e6b96 |
142 | { order_by => $self->position_column }, |
143 | ); |
7a76f44c |
144 | return $rs->all() if (wantarray()); |
145 | return $rs; |
118e6b96 |
146 | } |
147 | |
148 | =head2 first_sibling |
149 | |
a733c37f |
150 | my $sibling = $item->first_sibling(); |
118e6b96 |
151 | |
5faa95af |
152 | Returns the first sibling object, or 0 if the first sibling |
e9188247 |
153 | is this sibliing. |
118e6b96 |
154 | |
155 | =cut |
156 | |
157 | sub first_sibling { |
158 | my( $self ) = @_; |
5faa95af |
159 | return 0 if ($self->get_column($self->position_column())==1); |
fa6b598f |
160 | |
a9cdbec2 |
161 | return ($self->result_source->resultset->search( |
162 | { |
163 | $self->position_column => 1, |
a733c37f |
164 | $self->_grouping_clause(), |
a9cdbec2 |
165 | }, |
118e6b96 |
166 | )->all())[0]; |
167 | } |
168 | |
169 | =head2 last_sibling |
170 | |
a733c37f |
171 | my $sibling = $item->last_sibling(); |
118e6b96 |
172 | |
e9188247 |
173 | Return the last sibling, or 0 if the last sibling is this |
5faa95af |
174 | sibling. |
118e6b96 |
175 | |
176 | =cut |
177 | |
178 | sub last_sibling { |
179 | my( $self ) = @_; |
a733c37f |
180 | my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count(); |
5faa95af |
181 | return 0 if ($self->get_column($self->position_column())==$count); |
a9cdbec2 |
182 | return ($self->result_source->resultset->search( |
183 | { |
184 | $self->position_column => $count, |
a733c37f |
185 | $self->_grouping_clause(), |
a9cdbec2 |
186 | }, |
118e6b96 |
187 | )->all())[0]; |
188 | } |
189 | |
190 | =head2 previous_sibling |
191 | |
a733c37f |
192 | my $sibling = $item->previous_sibling(); |
118e6b96 |
193 | |
e9188247 |
194 | Returns the sibling that resides one position back. Undef |
195 | is returned if the current object is the first one. |
118e6b96 |
196 | |
197 | =cut |
198 | |
199 | sub previous_sibling { |
200 | my( $self ) = @_; |
201 | my $position_column = $self->position_column; |
707cbb2d |
202 | my $position = $self->get_column( $position_column ); |
203 | return 0 if ($position==1); |
3ffca97b |
204 | return ($self->result_source->resultset->search( |
7a76f44c |
205 | { |
707cbb2d |
206 | $position_column => $position - 1, |
a733c37f |
207 | $self->_grouping_clause(), |
707cbb2d |
208 | } |
118e6b96 |
209 | )->all())[0]; |
210 | } |
211 | |
212 | =head2 next_sibling |
213 | |
a733c37f |
214 | my $sibling = $item->next_sibling(); |
118e6b96 |
215 | |
e9188247 |
216 | Returns the sibling that resides one position foward. Undef |
217 | is returned if the current object is the last one. |
118e6b96 |
218 | |
219 | =cut |
220 | |
221 | sub next_sibling { |
222 | my( $self ) = @_; |
223 | my $position_column = $self->position_column; |
707cbb2d |
224 | my $position = $self->get_column( $position_column ); |
a733c37f |
225 | my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count(); |
707cbb2d |
226 | return 0 if ($position==$count); |
133dd22a |
227 | return ($self->result_source->resultset->search( |
7a76f44c |
228 | { |
707cbb2d |
229 | $position_column => $position + 1, |
a733c37f |
230 | $self->_grouping_clause(), |
7a76f44c |
231 | }, |
118e6b96 |
232 | )->all())[0]; |
233 | } |
234 | |
80010e2b |
235 | =head2 move_previous |
118e6b96 |
236 | |
a733c37f |
237 | $item->move_previous(); |
118e6b96 |
238 | |
e9188247 |
239 | Swaps position with the sibling on position previous in the list. |
240 | 1 is returned on success, and 0 is returned if the objects is already |
241 | the first one. |
118e6b96 |
242 | |
243 | =cut |
244 | |
80010e2b |
245 | sub move_previous { |
118e6b96 |
246 | my( $self ) = @_; |
133dd22a |
247 | my $position = $self->get_column( $self->position_column() ); |
248 | return $self->move_to( $position - 1 ); |
118e6b96 |
249 | } |
250 | |
80010e2b |
251 | =head2 move_next |
118e6b96 |
252 | |
a733c37f |
253 | $item->move_next(); |
118e6b96 |
254 | |
e9188247 |
255 | Swaps position with the sibling in the next position. 1 is returned on |
256 | success, and 0 is returned if the object is already the last in the list. |
118e6b96 |
257 | |
258 | =cut |
259 | |
80010e2b |
260 | sub move_next { |
118e6b96 |
261 | my( $self ) = @_; |
133dd22a |
262 | my $position = $self->get_column( $self->position_column() ); |
a733c37f |
263 | my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count(); |
133dd22a |
264 | return 0 if ($position==$count); |
265 | return $self->move_to( $position + 1 ); |
118e6b96 |
266 | } |
267 | |
268 | =head2 move_first |
269 | |
a733c37f |
270 | $item->move_first(); |
118e6b96 |
271 | |
e9188247 |
272 | Moves the object to the first position. 1 is returned on |
273 | success, and 0 is returned if the object is already the first. |
118e6b96 |
274 | |
275 | =cut |
276 | |
277 | sub move_first { |
278 | my( $self ) = @_; |
279 | return $self->move_to( 1 ); |
280 | } |
281 | |
282 | =head2 move_last |
283 | |
a733c37f |
284 | $item->move_last(); |
118e6b96 |
285 | |
e9188247 |
286 | Moves the object to the very last position. 1 is returned on |
287 | success, and 0 is returned if the object is already the last one. |
118e6b96 |
288 | |
289 | =cut |
290 | |
291 | sub move_last { |
292 | my( $self ) = @_; |
a733c37f |
293 | my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count(); |
118e6b96 |
294 | return $self->move_to( $count ); |
295 | } |
296 | |
297 | =head2 move_to |
298 | |
a733c37f |
299 | $item->move_to( $position ); |
118e6b96 |
300 | |
e9188247 |
301 | Moves the object to the specified position. 1 is returned on |
302 | success, and 0 is returned if the object is already at the |
303 | specified position. |
118e6b96 |
304 | |
305 | =cut |
306 | |
307 | sub move_to { |
308 | my( $self, $to_position ) = @_; |
309 | my $position_column = $self->position_column; |
310 | my $from_position = $self->get_column( $position_column ); |
133dd22a |
311 | return 0 if ( $to_position < 1 ); |
312 | return 0 if ( $from_position==$to_position ); |
dc66dea1 |
313 | my @between = ( |
314 | ( $from_position < $to_position ) |
315 | ? ( $from_position+1, $to_position ) |
316 | : ( $to_position, $from_position-1 ) |
317 | ); |
133dd22a |
318 | my $rs = $self->result_source->resultset->search({ |
dc66dea1 |
319 | $position_column => { -between => [ @between ] }, |
a733c37f |
320 | $self->_grouping_clause(), |
118e6b96 |
321 | }); |
322 | my $op = ($from_position>$to_position) ? '+' : '-'; |
fa6b598f |
323 | $rs->update({ $position_column => \"$position_column $op 1" }); #" Sorry, GEdit bug |
79dc353a |
324 | $self->{_ORDERED_INTERNAL_UPDATE} = 1; |
b1c66eea |
325 | $self->update({ $position_column => $to_position }); |
118e6b96 |
326 | return 1; |
327 | } |
328 | |
fa6b598f |
329 | |
330 | |
79dc353a |
331 | =head2 move_to_group |
332 | |
333 | $item->move_to_group( $group, $position ); |
334 | |
335 | Moves the object to the specified position of the specified |
336 | group, or to the end of the group if $position is undef. |
337 | 1 is returned on success, and 0 is returned if the object is |
338 | already at the specified position of the specified group. |
339 | |
1d941d67 |
340 | $group may be specified as a single scalar if only one |
341 | grouping column is in use, or as a hashref of column => value pairs |
342 | if multiple grouping columns are in use. |
fa6b598f |
343 | |
79dc353a |
344 | =cut |
345 | |
346 | sub move_to_group { |
347 | my( $self, $to_group, $to_position ) = @_; |
fa6b598f |
348 | |
349 | # if we're given a string, turn it into a hashref |
350 | unless (ref $to_group eq 'HASH') { |
351 | $to_group = {($self->_grouping_columns)[0] => $to_group}; |
352 | } |
353 | |
79dc353a |
354 | my $position_column = $self->position_column; |
fa6b598f |
355 | #my @grouping_columns = $self->_grouping_columns; |
79dc353a |
356 | |
357 | return 0 if ( ! defined($to_group) ); |
358 | return 0 if ( defined($to_position) and $to_position < 1 ); |
fa6b598f |
359 | return 0 if ( $self->_is_in_group($to_group) |
360 | and ((not defined($to_position)) |
361 | or (defined($to_position) and $self->$position_column==$to_position) |
362 | ) |
363 | ); |
79dc353a |
364 | |
365 | # Move to end of current group and adjust siblings |
366 | $self->move_last; |
367 | |
fa6b598f |
368 | $self->set_columns($to_group); |
79dc353a |
369 | my $new_group_count = $self->result_source->resultset->search({$self->_grouping_clause()})->count(); |
370 | if (!defined($to_position) or $to_position > $new_group_count) { |
371 | $self->{_ORDERED_INTERNAL_UPDATE} = 1; |
372 | $self->update({ $position_column => $new_group_count + 1 }); |
373 | } |
374 | else { |
375 | my @between = ($to_position, $new_group_count); |
376 | |
377 | my $rs = $self->result_source->resultset->search({ |
378 | $position_column => { -between => [ @between ] }, |
379 | $self->_grouping_clause(), |
380 | }); |
fa6b598f |
381 | $rs->update({ $position_column => \"$position_column + 1" }); #" |
79dc353a |
382 | $self->{_ORDERED_INTERNAL_UPDATE} = 1; |
383 | $self->update({ $position_column => $to_position }); |
384 | } |
385 | |
386 | return 1; |
387 | } |
388 | |
118e6b96 |
389 | =head2 insert |
390 | |
391 | Overrides the DBIC insert() method by providing a default |
392 | position number. The default will be the number of rows in |
393 | the table +1, thus positioning the new record at the last position. |
394 | |
395 | =cut |
396 | |
397 | sub insert { |
398 | my $self = shift; |
399 | my $position_column = $self->position_column; |
a733c37f |
400 | $self->set_column( $position_column => $self->result_source->resultset->search( {$self->_grouping_clause()} )->count()+1 ) |
118e6b96 |
401 | if (!$self->get_column($position_column)); |
0a298c73 |
402 | return $self->next::method( @_ ); |
118e6b96 |
403 | } |
404 | |
79dc353a |
405 | =head2 update |
406 | |
407 | Overrides the DBIC update() method by checking for a change |
408 | to the position and/or group columns. Movement within a |
409 | group or to another group is handled by repositioning |
410 | the appropriate siblings. Position defaults to the end |
411 | of a new group if it has been changed to undef. |
412 | |
413 | =cut |
414 | |
415 | sub update { |
416 | my $self = shift; |
417 | |
418 | if ($self->{_ORDERED_INTERNAL_UPDATE}) { |
419 | delete $self->{_ORDERED_INTERNAL_UPDATE}; |
420 | return $self->next::method( @_ ); |
421 | } |
422 | |
423 | $self->set_columns($_[0]) if @_ > 0; |
424 | my %changes = $self->get_dirty_columns; |
425 | $self->discard_changes; |
426 | |
427 | my $pos_col = $self->position_column; |
fa6b598f |
428 | |
fa6b598f |
429 | # if any of our grouping columns have been changed |
fa6b598f |
430 | if (grep {$_} map {exists $changes{$_}} $self->_grouping_columns ) { |
431 | |
432 | # create new_group by taking the current group and inserting changes |
433 | my $new_group = {$self->_grouping_clause}; |
434 | foreach my $col (keys %$new_group) { |
435 | if (exists $changes{$col}) { |
436 | $new_group->{$col} = $changes{$col}; |
437 | delete $changes{$col}; # don't want to pass this on to next::method |
438 | } |
439 | } |
440 | |
79dc353a |
441 | $self->move_to_group( |
fa6b598f |
442 | $new_group, |
79dc353a |
443 | exists($changes{$pos_col}) ? delete($changes{$pos_col}) : $self->$pos_col |
444 | ); |
445 | } |
446 | elsif (exists $changes{$pos_col}) { |
447 | $self->move_to(delete $changes{$pos_col}); |
448 | } |
449 | return $self->next::method( \%changes ); |
450 | } |
451 | |
118e6b96 |
452 | =head2 delete |
453 | |
454 | Overrides the DBIC delete() method by first moving the object |
455 | to the last position, then deleting it, thus ensuring the |
456 | integrity of the positions. |
457 | |
458 | =cut |
459 | |
460 | sub delete { |
461 | my $self = shift; |
462 | $self->move_last; |
0a298c73 |
463 | return $self->next::method( @_ ); |
118e6b96 |
464 | } |
465 | |
7a76f44c |
466 | =head1 PRIVATE METHODS |
467 | |
468 | These methods are used internally. You should never have the |
469 | need to use them. |
470 | |
a733c37f |
471 | =head2 _grouping_clause |
118e6b96 |
472 | |
e9188247 |
473 | This method returns one or more name=>value pairs for limiting a search |
474 | by the grouping column(s). If the grouping column is not |
133dd22a |
475 | defined then this will return an empty list. |
118e6b96 |
476 | |
7a76f44c |
477 | =cut |
a733c37f |
478 | sub _grouping_clause { |
169bb185 |
479 | my( $self ) = @_; |
fa6b598f |
480 | return map { $_ => $self->get_column($_) } $self->_grouping_columns(); |
481 | } |
482 | |
483 | |
484 | |
485 | =head2 _get_grouping_columns |
486 | |
487 | Returns a list of the column names used for grouping, regardless of whether |
1d941d67 |
488 | they were specified as an arrayref or a single string, and returns () |
489 | if there is no grouping. |
fa6b598f |
490 | |
491 | =cut |
492 | sub _grouping_columns { |
493 | my( $self ) = @_; |
a733c37f |
494 | my $col = $self->grouping_column(); |
fa6b598f |
495 | if (ref $col eq 'ARRAY') { |
496 | return @$col; |
497 | } elsif ($col) { |
498 | return ( $col ); |
499 | } else { |
500 | return (); |
133dd22a |
501 | } |
7a76f44c |
502 | } |
503 | |
fa6b598f |
504 | |
505 | |
506 | =head2 _is_in_group($other) |
507 | |
508 | $item->_is_in_group( {user => 'fred', list => 'work'} ) |
509 | |
510 | Returns true if the object is in the group represented by hashref $other |
511 | =cut |
512 | sub _is_in_group { |
513 | my ($self, $other) = @_; |
514 | my $current = {$self->_grouping_clause}; |
515 | return 0 unless (ref $other eq 'HASH') and (keys %$current == keys %$other); |
516 | for my $key (keys %$current) { |
517 | return 0 unless exists $other->{$key}; |
518 | return 0 if $current->{$key} ne $other->{$key}; |
519 | } |
520 | return 1; |
521 | } |
522 | |
523 | |
7a76f44c |
524 | 1; |
525 | __END__ |
118e6b96 |
526 | |
527 | =head1 BUGS |
528 | |
dc66dea1 |
529 | =head2 Unique Constraints |
530 | |
531 | Unique indexes and constraints on the position column are not |
532 | supported at this time. It would be make sense to support them, |
533 | but there are some unexpected database issues that make this |
534 | hard to do. The main problem from the author's view is that |
535 | SQLite (the DB engine that we use for testing) does not support |
536 | ORDER BY on updates. |
537 | |
133dd22a |
538 | =head2 Race Condition on Insert |
539 | |
118e6b96 |
540 | If a position is not specified for an insert than a position |
541 | will be chosen based on COUNT(*)+1. But, it first selects the |
e9188247 |
542 | count then inserts the record. The space of time between select |
118e6b96 |
543 | and insert introduces a race condition. To fix this we need the |
544 | ability to lock tables in DBIC. I've added an entry in the TODO |
545 | about this. |
546 | |
133dd22a |
547 | =head2 Multiple Moves |
548 | |
549 | Be careful when issueing move_* methods to multiple objects. If |
550 | you've pre-loaded the objects then when you move one of the objects |
551 | the position of the other object will not reflect their new value |
552 | until you reload them from the database. |
553 | |
dc66dea1 |
554 | There are times when you will want to move objects as groups, such |
133dd22a |
555 | as changeing the parent of several objects at once - this directly |
556 | conflicts with this problem. One solution is for us to write a |
557 | ResultSet class that supports a parent() method, for example. Another |
558 | solution is to somehow automagically modify the objects that exist |
559 | in the current object's result set to have the new position value. |
560 | |
118e6b96 |
561 | =head1 AUTHOR |
562 | |
563 | Aran Deltac <bluefeet@cpan.org> |
564 | |
565 | =head1 LICENSE |
566 | |
567 | You may distribute this code under the same terms as Perl itself. |
568 | |