Commit | Line | Data |
a733c37f |
1 | package DBIx::Class::Ordered; |
118e6b96 |
2 | use strict; |
3 | use warnings; |
4 | use base qw( DBIx::Class ); |
5 | |
6 | =head1 NAME |
7 | |
a733c37f |
8 | DBIx::Class::Ordered - Modify the position of objects in an ordered list. |
118e6b96 |
9 | |
10 | =head1 SYNOPSIS |
11 | |
a733c37f |
12 | Create a table for your ordered data. |
118e6b96 |
13 | |
a733c37f |
14 | CREATE TABLE items ( |
15 | item_id INTEGER PRIMARY KEY AUTOINCREMENT, |
118e6b96 |
16 | name TEXT NOT NULL, |
17 | position INTEGER NOT NULL |
18 | ); |
1d941d67 |
19 | |
e9188247 |
20 | Optionally, add one or more columns to specify groupings, allowing you |
21 | to maintain independent ordered lists within one table: |
22 | |
23 | CREATE TABLE items ( |
24 | item_id INTEGER PRIMARY KEY AUTOINCREMENT, |
25 | name TEXT NOT NULL, |
26 | position INTEGER NOT NULL, |
27 | group_id INTEGER NOT NULL |
28 | ); |
29 | |
30 | Or even |
31 | |
32 | CREATE TABLE items ( |
33 | item_id INTEGER PRIMARY KEY AUTOINCREMENT, |
34 | name TEXT NOT NULL, |
35 | position INTEGER NOT NULL, |
36 | group_id INTEGER NOT NULL, |
37 | other_group_id INTEGER NOT NULL |
38 | ); |
39 | |
a8492531 |
40 | In your Schema or DB class add "Ordered" to the top |
118e6b96 |
41 | of the component list. |
42 | |
a733c37f |
43 | __PACKAGE__->load_components(qw( Ordered ... )); |
118e6b96 |
44 | |
45 | Specify the column that stores the position number for |
46 | each row. |
47 | |
a733c37f |
48 | package My::Item; |
118e6b96 |
49 | __PACKAGE__->position_column('position'); |
1d941d67 |
50 | |
e9188247 |
51 | If you are using one grouping column, specify it as follows: |
52 | |
53 | __PACKAGE__->grouping_column('group_id'); |
54 | |
55 | Or if you have multiple grouping columns: |
56 | |
57 | __PACKAGE__->grouping_column(['group_id', 'other_group_id']); |
58 | |
a8492531 |
59 | That's it, now you can change the position of your objects. |
118e6b96 |
60 | |
61 | #!/use/bin/perl |
a733c37f |
62 | use My::Item; |
d4daee7b |
63 | |
a733c37f |
64 | my $item = My::Item->create({ name=>'Matt S. Trout' }); |
65 | # If using grouping_column: |
66 | my $item = My::Item->create({ name=>'Matt S. Trout', group_id=>1 }); |
d4daee7b |
67 | |
a733c37f |
68 | my $rs = $item->siblings(); |
69 | my @siblings = $item->siblings(); |
d4daee7b |
70 | |
118e6b96 |
71 | my $sibling; |
a733c37f |
72 | $sibling = $item->first_sibling(); |
73 | $sibling = $item->last_sibling(); |
74 | $sibling = $item->previous_sibling(); |
75 | $sibling = $item->next_sibling(); |
d4daee7b |
76 | |
a733c37f |
77 | $item->move_previous(); |
78 | $item->move_next(); |
79 | $item->move_first(); |
80 | $item->move_last(); |
81 | $item->move_to( $position ); |
1d941d67 |
82 | $item->move_to_group( 'groupname' ); |
83 | $item->move_to_group( 'groupname', $position ); |
84 | $item->move_to_group( {group_id=>'groupname', 'other_group_id=>'othergroupname'} ); |
85 | $item->move_to_group( {group_id=>'groupname', 'other_group_id=>'othergroupname'}, $position ); |
118e6b96 |
86 | |
87 | =head1 DESCRIPTION |
88 | |
a733c37f |
89 | This module provides a simple interface for modifying the ordered |
90 | position of DBIx::Class objects. |
118e6b96 |
91 | |
133dd22a |
92 | =head1 AUTO UPDATE |
93 | |
94 | All of the move_* methods automatically update the rows involved in |
95 | the query. This is not configurable and is due to the fact that if you |
96 | move a record it always causes other records in the list to be updated. |
97 | |
118e6b96 |
98 | =head1 METHODS |
99 | |
100 | =head2 position_column |
101 | |
102 | __PACKAGE__->position_column('position'); |
103 | |
104 | Sets and retrieves the name of the column that stores the |
a8492531 |
105 | positional value of each record. Defaults to "position". |
118e6b96 |
106 | |
107 | =cut |
108 | |
109 | __PACKAGE__->mk_classdata( 'position_column' => 'position' ); |
110 | |
a733c37f |
111 | =head2 grouping_column |
133dd22a |
112 | |
a733c37f |
113 | __PACKAGE__->grouping_column('group_id'); |
133dd22a |
114 | |
a8492531 |
115 | This method specifies a column to limit all queries in |
133dd22a |
116 | this module by. This effectively allows you to have multiple |
a733c37f |
117 | ordered lists within the same table. |
133dd22a |
118 | |
119 | =cut |
120 | |
335ed892 |
121 | __PACKAGE__->mk_classdata('grouping_column'); |
133dd22a |
122 | |
bd7ca9e8 |
123 | =head2 null_position_value |
124 | |
125 | __PACKAGE__->null_position_value(undef); |
126 | |
127 | This method specifies a value of L</position_column> which B<would |
128 | never be assigned to a row> during normal operation. When |
129 | a row is moved, its position is set to this value temporarily, so |
48580715 |
130 | that any unique constraints can not be violated. This value defaults |
bd7ca9e8 |
131 | to 0, which should work for all cases except when your positions do |
132 | indeed start from 0. |
133 | |
134 | =cut |
135 | |
136 | __PACKAGE__->mk_classdata( 'null_position_value' => 0 ); |
137 | |
118e6b96 |
138 | =head2 siblings |
139 | |
a733c37f |
140 | my $rs = $item->siblings(); |
141 | my @siblings = $item->siblings(); |
118e6b96 |
142 | |
bd7ca9e8 |
143 | Returns an B<ordered> resultset of all other objects in the same |
144 | group excluding the one you called it on. |
118e6b96 |
145 | |
bd7ca9e8 |
146 | The ordering is a backwards-compatibility artifact - if you need |
147 | a resultset with no ordering applied use L</_siblings> |
118e6b96 |
148 | |
bd7ca9e8 |
149 | =cut |
335ed892 |
150 | |
118e6b96 |
151 | sub siblings { |
335ed892 |
152 | my $self = shift; |
153 | return $self->_siblings->search( {}, { order_by => $self->position_column } ); |
118e6b96 |
154 | } |
155 | |
bd7ca9e8 |
156 | =head2 previous_siblings |
118e6b96 |
157 | |
bd7ca9e8 |
158 | my $prev_rs = $item->previous_siblings(); |
159 | my @prev_siblings = $item->previous_siblings(); |
118e6b96 |
160 | |
bd7ca9e8 |
161 | Returns a resultset of all objects in the same group |
162 | positioned before the object on which this method was called. |
118e6b96 |
163 | |
164 | =cut |
335ed892 |
165 | |
bd7ca9e8 |
166 | sub previous_siblings { |
335ed892 |
167 | my $self = shift; |
168 | my $position_column = $self->position_column; |
169 | my $position = $self->get_column($position_column); |
170 | return ( |
171 | defined $position |
172 | ? $self->_siblings->search( { $position_column => { '<', $position } } ) |
173 | : $self->_siblings |
174 | ); |
118e6b96 |
175 | } |
176 | |
bd7ca9e8 |
177 | =head2 next_siblings |
118e6b96 |
178 | |
bd7ca9e8 |
179 | my $next_rs = $item->next_siblings(); |
180 | my @next_siblings = $item->next_siblings(); |
118e6b96 |
181 | |
bd7ca9e8 |
182 | Returns a resultset of all objects in the same group |
183 | positioned after the object on which this method was called. |
118e6b96 |
184 | |
185 | =cut |
335ed892 |
186 | |
bd7ca9e8 |
187 | sub next_siblings { |
335ed892 |
188 | my $self = shift; |
189 | my $position_column = $self->position_column; |
190 | my $position = $self->get_column($position_column); |
191 | return ( |
192 | defined $position |
193 | ? $self->_siblings->search( { $position_column => { '>', $position } } ) |
194 | : $self->_siblings |
195 | ); |
118e6b96 |
196 | } |
197 | |
198 | =head2 previous_sibling |
199 | |
a733c37f |
200 | my $sibling = $item->previous_sibling(); |
118e6b96 |
201 | |
bd7ca9e8 |
202 | Returns the sibling that resides one position back. Returns 0 |
a8492531 |
203 | if the current object is the first one. |
118e6b96 |
204 | |
205 | =cut |
206 | |
207 | sub previous_sibling { |
335ed892 |
208 | my $self = shift; |
209 | my $position_column = $self->position_column; |
bd7ca9e8 |
210 | |
335ed892 |
211 | my $psib = |
212 | $self->previous_siblings->search( {}, |
213 | { rows => 1, order_by => { '-desc' => $position_column } }, |
bd7ca9e8 |
214 | )->single; |
215 | |
335ed892 |
216 | return defined $psib ? $psib : 0; |
bd7ca9e8 |
217 | } |
218 | |
219 | =head2 first_sibling |
220 | |
221 | my $sibling = $item->first_sibling(); |
222 | |
223 | Returns the first sibling object, or 0 if the first sibling |
224 | is this sibling. |
225 | |
226 | =cut |
227 | |
228 | sub first_sibling { |
335ed892 |
229 | my $self = shift; |
230 | my $position_column = $self->position_column; |
bd7ca9e8 |
231 | |
335ed892 |
232 | my $fsib = |
233 | $self->previous_siblings->search( {}, |
234 | { rows => 1, order_by => { '-asc' => $position_column } }, |
bd7ca9e8 |
235 | )->single; |
236 | |
335ed892 |
237 | return defined $fsib ? $fsib : 0; |
118e6b96 |
238 | } |
239 | |
240 | =head2 next_sibling |
241 | |
a733c37f |
242 | my $sibling = $item->next_sibling(); |
118e6b96 |
243 | |
bd7ca9e8 |
244 | Returns the sibling that resides one position forward. Returns 0 |
a8492531 |
245 | if the current object is the last one. |
118e6b96 |
246 | |
247 | =cut |
248 | |
249 | sub next_sibling { |
335ed892 |
250 | my $self = shift; |
251 | my $position_column = $self->position_column; |
252 | my $nsib = |
253 | $self->next_siblings->search( {}, |
254 | { rows => 1, order_by => { '-asc' => $position_column } }, |
bd7ca9e8 |
255 | )->single; |
256 | |
335ed892 |
257 | return defined $nsib ? $nsib : 0; |
bd7ca9e8 |
258 | } |
259 | |
260 | =head2 last_sibling |
261 | |
262 | my $sibling = $item->last_sibling(); |
263 | |
264 | Returns the last sibling, or 0 if the last sibling is this |
265 | sibling. |
266 | |
267 | =cut |
268 | |
269 | sub last_sibling { |
335ed892 |
270 | my $self = shift; |
271 | my $position_column = $self->position_column; |
272 | my $lsib = |
273 | $self->next_siblings->search( {}, |
274 | { rows => 1, order_by => { '-desc' => $position_column } }, |
bd7ca9e8 |
275 | )->single; |
276 | |
335ed892 |
277 | return defined $lsib ? $lsib : 0; |
118e6b96 |
278 | } |
279 | |
d7c0e320 |
280 | # an optimized method to get the last sibling position value without inflating a row object |
281 | sub _last_sibling_posval { |
335ed892 |
282 | my $self = shift; |
283 | my $position_column = $self->position_column; |
82a8f76f |
284 | |
335ed892 |
285 | my $cursor = $self->next_siblings->search( |
286 | {}, |
287 | { |
288 | rows => 1, |
289 | order_by => { '-desc' => $position_column }, |
290 | select => $position_column |
291 | }, |
292 | )->cursor; |
293 | |
294 | my ($pos) = $cursor->next; |
295 | return $pos; |
82a8f76f |
296 | } |
297 | |
80010e2b |
298 | =head2 move_previous |
118e6b96 |
299 | |
a733c37f |
300 | $item->move_previous(); |
118e6b96 |
301 | |
a8492531 |
302 | Swaps position with the sibling in the position previous in |
303 | the list. Returns 1 on success, and 0 if the object is |
304 | already the first one. |
118e6b96 |
305 | |
306 | =cut |
307 | |
80010e2b |
308 | sub move_previous { |
335ed892 |
309 | my $self = shift; |
310 | return $self->move_to( $self->_position - 1 ); |
118e6b96 |
311 | } |
312 | |
80010e2b |
313 | =head2 move_next |
118e6b96 |
314 | |
a733c37f |
315 | $item->move_next(); |
118e6b96 |
316 | |
a8492531 |
317 | Swaps position with the sibling in the next position in the |
318 | list. Returns 1 on success, and 0 if the object is already |
319 | the last in the list. |
118e6b96 |
320 | |
321 | =cut |
322 | |
80010e2b |
323 | sub move_next { |
335ed892 |
324 | my $self = shift; |
325 | return 0 |
326 | unless defined |
327 | $self->_last_sibling_posval; # quick way to check for no more siblings |
328 | return $self->move_to( $self->_position + 1 ); |
118e6b96 |
329 | } |
330 | |
331 | =head2 move_first |
332 | |
a733c37f |
333 | $item->move_first(); |
118e6b96 |
334 | |
a8492531 |
335 | Moves the object to the first position in the list. Returns 1 |
336 | on success, and 0 if the object is already the first. |
118e6b96 |
337 | |
338 | =cut |
339 | |
340 | sub move_first { |
335ed892 |
341 | return shift->move_to(1); |
118e6b96 |
342 | } |
343 | |
344 | =head2 move_last |
345 | |
a733c37f |
346 | $item->move_last(); |
118e6b96 |
347 | |
a8492531 |
348 | Moves the object to the last position in the list. Returns 1 |
349 | on success, and 0 if the object is already the last one. |
118e6b96 |
350 | |
351 | =cut |
352 | |
353 | sub move_last { |
335ed892 |
354 | my $self = shift; |
355 | my $last_posval = $self->_last_sibling_posval; |
d7c0e320 |
356 | |
335ed892 |
357 | return 0 unless defined $last_posval; |
d7c0e320 |
358 | |
335ed892 |
359 | return $self->move_to( $self->_position_from_value($last_posval) ); |
118e6b96 |
360 | } |
361 | |
362 | =head2 move_to |
363 | |
a733c37f |
364 | $item->move_to( $position ); |
118e6b96 |
365 | |
a8492531 |
366 | Moves the object to the specified position. Returns 1 on |
367 | success, and 0 if the object is already at the specified |
368 | position. |
118e6b96 |
369 | |
370 | =cut |
371 | |
372 | sub move_to { |
335ed892 |
373 | my ( $self, $to_position ) = @_; |
374 | return 0 if ( $to_position < 1 ); |
bd7ca9e8 |
375 | |
335ed892 |
376 | my $position_column = $self->position_column; |
8f535707 |
377 | |
335ed892 |
378 | my $guard; |
bd7ca9e8 |
379 | |
335ed892 |
380 | if ( $self->is_column_changed($position_column) ) { |
b250066f |
381 | |
335ed892 |
382 | # something changed our position, we have no idea where we |
383 | # used to be - requery without using discard_changes |
384 | # (we need only a specific column back) |
b250066f |
385 | |
335ed892 |
386 | $guard = $self->result_source->schema->txn_scope_guard; |
fa6b598f |
387 | |
335ed892 |
388 | my $cursor = |
389 | $self->result_source->resultset->search( $self->ident_condition, |
390 | { select => $position_column }, |
391 | )->cursor; |
87b4a877 |
392 | |
335ed892 |
393 | my ($pos) = $cursor->next; |
394 | $self->$position_column($pos); |
395 | delete $self->{_dirty_columns}{$position_column}; |
396 | } |
397 | |
398 | my $from_position = $self->_position; |
399 | |
400 | if ( $from_position == $to_position ) |
401 | { # FIXME this will not work for non-numeric order |
402 | $guard->commit if $guard; |
403 | return 0; |
404 | } |
405 | |
406 | $guard ||= $self->result_source->schema->txn_scope_guard; |
407 | |
408 | my ( $direction, @between ); |
409 | if ( $from_position < $to_position ) { |
410 | $direction = -1; |
411 | @between = |
412 | map { $self->_position_value($_) } ( $from_position + 1, $to_position ); |
413 | } else { |
414 | $direction = 1; |
415 | @between = |
416 | map { $self->_position_value($_) } ( $to_position, $from_position - 1 ); |
417 | } |
418 | |
419 | my $new_pos_val = |
420 | $self->_position_value($to_position); # record this before the shift |
421 | |
422 | # we need to null-position the moved row if the position column is part of a constraint |
423 | if ( |
424 | grep { $_ eq $position_column } ( |
425 | map { @$_ } ( values %{ { $self->result_source->unique_constraints } } ) |
426 | ) |
427 | ) |
428 | { |
429 | $self->_ordered_internal_update( |
430 | { $position_column => $self->null_position_value } ); |
431 | } |
432 | |
433 | $self->_shift_siblings( $direction, @between ); |
434 | $self->_ordered_internal_update( { $position_column => $new_pos_val } ); |
435 | |
436 | $guard->commit; |
437 | return 1; |
bd7ca9e8 |
438 | } |
fa6b598f |
439 | |
79dc353a |
440 | =head2 move_to_group |
441 | |
442 | $item->move_to_group( $group, $position ); |
443 | |
444 | Moves the object to the specified position of the specified |
445 | group, or to the end of the group if $position is undef. |
446 | 1 is returned on success, and 0 is returned if the object is |
447 | already at the specified position of the specified group. |
448 | |
1d941d67 |
449 | $group may be specified as a single scalar if only one |
450 | grouping column is in use, or as a hashref of column => value pairs |
451 | if multiple grouping columns are in use. |
fa6b598f |
452 | |
79dc353a |
453 | =cut |
454 | |
455 | sub move_to_group { |
335ed892 |
456 | my ( $self, $to_group, $to_position ) = @_; |
457 | |
458 | # if we're given a single value, turn it into a hashref |
459 | unless ( ref $to_group eq 'HASH' ) { |
460 | my @gcols = $self->_grouping_columns; |
461 | |
462 | $self->throw_exception( |
463 | 'Single group supplied for a multi-column group identifier') |
464 | if @gcols > 1; |
465 | $to_group = { $gcols[0] => $to_group }; |
466 | } |
467 | |
468 | my $position_column = $self->position_column; |
469 | |
470 | return 0 if ( defined($to_position) and $to_position < 1 ); |
471 | |
472 | # check if someone changed the _grouping_columns - this will |
473 | # prevent _is_in_group working, so we need to requery the db |
474 | # for the original values |
475 | my ( @dirty_cols, %values, $guard ); |
476 | for ( $self->_grouping_columns ) { |
477 | $values{$_} = $self->get_column($_); |
478 | push @dirty_cols, $_ if $self->is_column_changed($_); |
479 | } |
480 | |
481 | # re-query only the dirty columns, and restore them on the |
482 | # object (subsequent code will update them to the correct |
483 | # after-move values) |
484 | if (@dirty_cols) { |
485 | $guard = $self->result_source->schema->txn_scope_guard; |
486 | |
487 | my $cursor = |
488 | $self->result_source->resultset->search( $self->ident_condition, |
489 | { select => \@dirty_cols }, |
87b4a877 |
490 | )->cursor; |
bd7ca9e8 |
491 | |
335ed892 |
492 | my @original_values = $cursor->next; |
493 | $self->set_inflated_columns( |
494 | { %values, map { $_ => shift @original_values } (@dirty_cols) } ); |
495 | delete $self->{_dirty_columns}{$_} for (@dirty_cols); |
496 | } |
bd7ca9e8 |
497 | |
335ed892 |
498 | if ( $self->_is_in_group($to_group) ) { |
499 | my $ret; |
500 | if ( defined $to_position ) { |
501 | $ret = $self->move_to($to_position); |
87b4a877 |
502 | } |
bd7ca9e8 |
503 | |
335ed892 |
504 | $guard->commit if $guard; |
505 | return $ret || 0; |
506 | } |
87b4a877 |
507 | |
335ed892 |
508 | $guard ||= $self->result_source->schema->txn_scope_guard; |
87b4a877 |
509 | |
335ed892 |
510 | # Move to end of current group to adjust siblings |
511 | $self->move_last; |
512 | |
513 | $self->set_inflated_columns( { %$to_group, $position_column => undef } ); |
514 | my $new_group_last_posval = $self->_last_sibling_posval; |
515 | my $new_group_last_position = |
516 | $self->_position_from_value($new_group_last_posval); |
8f535707 |
517 | |
335ed892 |
518 | if ( not defined($to_position) or $to_position > $new_group_last_position ) { |
519 | $self->set_column( |
87b4a877 |
520 | $position_column => $new_group_last_position |
335ed892 |
521 | ? $self->_next_position_value($new_group_last_posval) |
522 | : $self->_initial_position_value |
523 | ); |
524 | } else { |
525 | my $bumped_pos_val = $self->_position_value($to_position); |
526 | my @between = |
527 | map { $self->_position_value($_) } |
528 | ( $to_position, $new_group_last_position ); |
529 | $self->_shift_siblings( 1, @between ); #shift right |
530 | $self->set_column( $position_column => $bumped_pos_val ); |
531 | } |
87b4a877 |
532 | |
335ed892 |
533 | $self->_ordered_internal_update; |
87b4a877 |
534 | |
335ed892 |
535 | $guard->commit; |
87b4a877 |
536 | |
335ed892 |
537 | return 1; |
79dc353a |
538 | } |
539 | |
118e6b96 |
540 | =head2 insert |
541 | |
542 | Overrides the DBIC insert() method by providing a default |
543 | position number. The default will be the number of rows in |
544 | the table +1, thus positioning the new record at the last position. |
545 | |
546 | =cut |
547 | |
548 | sub insert { |
335ed892 |
549 | my $self = shift; |
550 | my $position_column = $self->position_column; |
551 | |
552 | unless ( $self->get_column($position_column) ) { |
553 | my $lsib_posval = $self->_last_sibling_posval; |
554 | $self->set_column( |
555 | $position_column => ( |
556 | defined $lsib_posval |
557 | ? $self->_next_position_value($lsib_posval) |
558 | : $self->_initial_position_value |
559 | ) |
560 | ); |
561 | } |
bd7ca9e8 |
562 | |
335ed892 |
563 | return $self->next::method(@_); |
118e6b96 |
564 | } |
565 | |
79dc353a |
566 | =head2 update |
567 | |
568 | Overrides the DBIC update() method by checking for a change |
569 | to the position and/or group columns. Movement within a |
570 | group or to another group is handled by repositioning |
571 | the appropriate siblings. Position defaults to the end |
572 | of a new group if it has been changed to undef. |
573 | |
574 | =cut |
575 | |
576 | sub update { |
335ed892 |
577 | my $self = shift; |
578 | |
579 | # this is set by _ordered_internal_update() |
580 | return $self->next::method(@_) if $self->{_ORDERED_INTERNAL_UPDATE}; |
581 | |
582 | my $position_column = $self->position_column; |
583 | my @ordering_columns = ( $self->_grouping_columns, $position_column ); |
584 | |
585 | # these steps are necessary to keep the external appearance of |
586 | # ->update($upd) so that other things overloading update() will |
587 | # work properly |
588 | my %original_values = $self->get_columns; |
589 | my %existing_changes = $self->get_dirty_columns; |
590 | |
591 | # See if any of the *supplied* changes would affect the ordering |
592 | # The reason this is so contrived, is that we want to leverage |
593 | # the datatype aware value comparing, while at the same time |
594 | # keep the original value intact (it will be updated later by the |
595 | # corresponding routine) |
596 | |
597 | my %upd = %{ shift || {} }; |
598 | my %changes = %existing_changes; |
599 | |
600 | for (@ordering_columns) { |
601 | next unless exists $upd{$_}; |
602 | |
603 | # we do not want to keep propagating this to next::method |
604 | # as it will be a done deal by the time get there |
605 | my $value = delete $upd{$_}; |
606 | $self->set_inflated_columns( { $_ => $value } ); |
607 | |
608 | # see if an update resulted in a dirty column |
609 | # it is important to preserve the old value, as it |
610 | # will be needed to carry on a successfull move() |
611 | # operation without re-querying the database |
612 | if ( $self->is_column_changed($_) && not exists $existing_changes{$_} ) { |
613 | $changes{$_} = $value; |
614 | $self->set_inflated_columns( { $_ => $original_values{$_} } ); |
615 | delete $self->{_dirty_columns}{$_}; |
87b4a877 |
616 | } |
335ed892 |
617 | } |
618 | |
619 | # if nothing group/position related changed - short circuit |
620 | if ( not grep { exists $changes{$_} } (@ordering_columns) ) { |
621 | return $self->next::method( \%upd, @_ ); |
622 | } |
623 | |
624 | { |
625 | my $guard = $self->result_source->schema->txn_scope_guard; |
626 | |
627 | # if any of our grouping columns have been changed |
628 | if ( grep { exists $changes{$_} } ( $self->_grouping_columns ) ) { |
629 | |
630 | # create new_group by taking the current group and inserting changes |
631 | my $new_group = { $self->_grouping_clause }; |
632 | foreach my $col ( keys %$new_group ) { |
633 | $new_group->{$col} = $changes{$col} if exists $changes{$col}; |
634 | } |
fa6b598f |
635 | |
335ed892 |
636 | $self->move_to_group( |
637 | $new_group, |
638 | ( |
639 | exists $changes{$position_column} |
640 | |
641 | # The FIXME bit contradicts the documentation: POD states that |
642 | # when changing groups without supplying explicit positions in |
643 | # move_to_group(), we push the item to the end of the group. |
644 | # However when I was rewriting this, the position from the old |
645 | # group was clearly passed to the new one |
646 | # Probably needs to go away (by ribasushi) |
647 | ? $changes{ $position_column |
648 | } # means there was a position change supplied with the update too |
649 | : $self->_position # FIXME! (replace with undef) |
650 | ), |
651 | ); |
652 | } elsif ( exists $changes{$position_column} ) { |
653 | $self->move_to( $changes{$position_column} ); |
bd7ca9e8 |
654 | } |
fa6b598f |
655 | |
335ed892 |
656 | my @res; |
657 | if ( not defined wantarray ) { |
658 | $self->next::method( \%upd, @_ ); |
659 | } elsif (wantarray) { |
660 | @res = $self->next::method( \%upd, @_ ); |
661 | } else { |
662 | $res[0] = $self->next::method( \%upd, @_ ); |
79dc353a |
663 | } |
335ed892 |
664 | |
665 | $guard->commit; |
666 | return wantarray ? @res : $res[0]; |
667 | } |
79dc353a |
668 | } |
669 | |
118e6b96 |
670 | =head2 delete |
671 | |
672 | Overrides the DBIC delete() method by first moving the object |
bd7ca9e8 |
673 | to the last position, then deleting it, thus ensuring the |
118e6b96 |
674 | integrity of the positions. |
675 | |
676 | =cut |
677 | |
678 | sub delete { |
335ed892 |
679 | my $self = shift; |
8f535707 |
680 | |
335ed892 |
681 | my $guard = $self->result_source->schema->txn_scope_guard; |
8f535707 |
682 | |
335ed892 |
683 | $self->move_last; |
8f535707 |
684 | |
335ed892 |
685 | my @res; |
686 | if ( not defined wantarray ) { |
687 | $self->next::method(@_); |
688 | } elsif (wantarray) { |
689 | @res = $self->next::method(@_); |
690 | } else { |
691 | $res[0] = $self->next::method(@_); |
692 | } |
8f535707 |
693 | |
335ed892 |
694 | $guard->commit; |
695 | return wantarray ? @res : $res[0]; |
bd7ca9e8 |
696 | } |
697 | |
b250066f |
698 | =head1 METHODS FOR EXTENDING ORDERED |
bd7ca9e8 |
699 | |
700 | You would want to override the methods below if you use sparse |
701 | (non-linear) or non-numeric position values. This can be useful |
702 | if you are working with preexisting non-normalised position data, |
703 | or if you need to work with materialized path columns. |
704 | |
d7c0e320 |
705 | =head2 _position_from_value |
706 | |
69cd8a7f |
707 | my $num_pos = $item->_position_from_value ( $pos_value ) |
d7c0e320 |
708 | |
709 | Returns the B<absolute numeric position> of an object with a B<position |
710 | value> set to C<$pos_value>. By default simply returns C<$pos_value>. |
711 | |
712 | =cut |
335ed892 |
713 | |
d7c0e320 |
714 | sub _position_from_value { |
335ed892 |
715 | my ( $self, $val ) = @_; |
d7c0e320 |
716 | |
335ed892 |
717 | return 0 unless defined $val; |
d7c0e320 |
718 | |
335ed892 |
719 | # #the right way to do this |
720 | # return $self -> _group_rs |
721 | # -> search({ $self->position_column => { '<=', $val } }) |
722 | # -> count |
d7c0e320 |
723 | |
335ed892 |
724 | return $val; |
d7c0e320 |
725 | } |
726 | |
bd7ca9e8 |
727 | =head2 _position_value |
728 | |
729 | my $pos_value = $item->_position_value ( $pos ) |
730 | |
b250066f |
731 | Returns the B<value> of L</position_column> of the object at numeric |
bd7ca9e8 |
732 | position C<$pos>. By default simply returns C<$pos>. |
733 | |
734 | =cut |
335ed892 |
735 | |
bd7ca9e8 |
736 | sub _position_value { |
335ed892 |
737 | my ( $self, $pos ) = @_; |
bd7ca9e8 |
738 | |
335ed892 |
739 | # #the right way to do this (not optimized) |
740 | # my $position_column = $self->position_column; |
741 | # return $self -> _group_rs |
742 | # -> search({}, { order_by => $position_column }) |
743 | # -> slice ( $pos - 1) |
744 | # -> single |
745 | # -> get_column ($position_column); |
bd7ca9e8 |
746 | |
335ed892 |
747 | return $pos; |
bd7ca9e8 |
748 | } |
749 | |
750 | =head2 _initial_position_value |
751 | |
752 | __PACKAGE__->_initial_position_value(0); |
753 | |
b250066f |
754 | This method specifies a B<value> of L</position_column> which is assigned |
bd7ca9e8 |
755 | to the first inserted element of a group, if no value was supplied at |
756 | insertion time. All subsequent values are derived from this one by |
757 | L</_next_position_value> below. Defaults to 1. |
758 | |
759 | =cut |
760 | |
761 | __PACKAGE__->mk_classdata( '_initial_position_value' => 1 ); |
762 | |
763 | =head2 _next_position_value |
764 | |
765 | my $new_value = $item->_next_position_value ( $position_value ) |
766 | |
b250066f |
767 | Returns a position B<value> that would be considered C<next> with |
bd7ca9e8 |
768 | regards to C<$position_value>. Can be pretty much anything, given |
769 | that C<< $position_value < $new_value >> where C<< < >> is the |
770 | SQL comparison operator (usually works fine on strings). The |
771 | default method expects C<$position_value> to be numeric, and |
772 | returns C<$position_value + 1> |
773 | |
774 | =cut |
335ed892 |
775 | |
bd7ca9e8 |
776 | sub _next_position_value { |
335ed892 |
777 | return $_[1] + 1; |
bd7ca9e8 |
778 | } |
779 | |
780 | =head2 _shift_siblings |
781 | |
782 | $item->_shift_siblings ($direction, @between) |
783 | |
b250066f |
784 | Shifts all siblings with B<positions values> in the range @between |
785 | (inclusive) by one position as specified by $direction (left if < 0, |
786 | right if > 0). By default simply increments/decrements each |
787 | L<position_column> value by 1, doing so in a way as to not violate |
788 | any existing constraints. |
789 | |
790 | Note that if you override this method and have unique constraints |
791 | including the L<position_column> the shift is not a trivial task. |
792 | Refer to the implementation source of the default method for more |
793 | information. |
bd7ca9e8 |
794 | |
795 | =cut |
82a8f76f |
796 | |
335ed892 |
797 | sub _shift_siblings { |
798 | my ( $self, $direction, @between ) = @_; |
799 | return 0 unless $direction; |
800 | |
801 | my $position_column = $self->position_column; |
802 | |
803 | my ( $op, $ord ); |
804 | if ( $direction < 0 ) { |
805 | $op = '-'; |
806 | $ord = 'asc'; |
807 | } else { |
808 | $op = '+'; |
809 | $ord = 'desc'; |
810 | } |
811 | |
812 | my $shift_rs = $self->_group_rs->search( |
813 | { $position_column => { -between => \@between } } ); |
814 | |
815 | # some databases (sqlite) are dumb and can not do a blanket |
816 | # increment/decrement. So what we do here is check if the |
817 | # position column is part of a unique constraint, and do a |
818 | # one-by-one update if this is the case |
819 | |
820 | my $rsrc = $self->result_source; |
821 | |
822 | if ( grep { $_ eq $position_column } |
823 | ( map { @$_ } ( values %{ { $rsrc->unique_constraints } } ) ) ) |
824 | { |
825 | |
826 | my @pcols = $rsrc->_pri_cols; |
827 | my $cursor = |
828 | $shift_rs->search( {}, |
829 | { order_by => { "-$ord", $position_column }, columns => \@pcols } ) |
830 | ->cursor; |
831 | my $rs = $self->result_source->resultset; |
832 | |
833 | my @all_pks = $cursor->all; |
834 | while ( my $pks = shift @all_pks ) { |
835 | my $cond; |
836 | for my $i ( 0 .. $#pcols ) { |
837 | $cond->{ $pcols[$i] } = $pks->[$i]; |
838 | } |
bd7ca9e8 |
839 | |
335ed892 |
840 | $rs->search($cond) |
841 | ->update( { $position_column => \"$position_column $op 1" } ); |
bd7ca9e8 |
842 | } |
335ed892 |
843 | } else { |
844 | $shift_rs->update( { $position_column => \"$position_column $op 1" } ); |
845 | } |
118e6b96 |
846 | } |
847 | |
7a76f44c |
848 | =head1 PRIVATE METHODS |
849 | |
850 | These methods are used internally. You should never have the |
851 | need to use them. |
852 | |
bd7ca9e8 |
853 | =head2 _group_rs |
854 | |
b250066f |
855 | This method returns a resultset containing all members of the row |
bd7ca9e8 |
856 | group (including the row itself). |
857 | |
858 | =cut |
335ed892 |
859 | |
bd7ca9e8 |
860 | sub _group_rs { |
335ed892 |
861 | my $self = shift; |
862 | return $self->result_source->resultset->search( |
863 | { $self->_grouping_clause() } ); |
bd7ca9e8 |
864 | } |
865 | |
866 | =head2 _siblings |
867 | |
868 | Returns an unordered resultset of all objects in the same group |
869 | excluding the object you called this method on. |
870 | |
871 | =cut |
335ed892 |
872 | |
bd7ca9e8 |
873 | sub _siblings { |
335ed892 |
874 | my $self = shift; |
875 | my $position_column = $self->position_column; |
876 | return $self->_group_rs->search( |
877 | { $position_column => { '!=' => $self->get_column($position_column) } }, |
878 | ); |
bd7ca9e8 |
879 | } |
880 | |
69cd8a7f |
881 | =head2 _position |
882 | |
883 | my $num_pos = $item->_position; |
884 | |
885 | Returns the B<absolute numeric position> of the current object, with the |
886 | first object being at position 1, its sibling at position 2 and so on. |
887 | |
888 | =cut |
335ed892 |
889 | |
69cd8a7f |
890 | sub _position { |
335ed892 |
891 | my $self = shift; |
892 | return $self->_position_from_value( |
893 | $self->get_column( $self->position_column ) ); |
69cd8a7f |
894 | } |
895 | |
a733c37f |
896 | =head2 _grouping_clause |
118e6b96 |
897 | |
bd7ca9e8 |
898 | This method returns one or more name=>value pairs for limiting a search |
87b4a877 |
899 | by the grouping column(s). If the grouping column is not defined then |
900 | this will return an empty list. |
118e6b96 |
901 | |
7a76f44c |
902 | =cut |
335ed892 |
903 | |
a733c37f |
904 | sub _grouping_clause { |
335ed892 |
905 | my ($self) = @_; |
906 | return map { $_ => $self->get_column($_) } $self->_grouping_columns(); |
fa6b598f |
907 | } |
908 | |
fa6b598f |
909 | =head2 _get_grouping_columns |
910 | |
911 | Returns a list of the column names used for grouping, regardless of whether |
1d941d67 |
912 | they were specified as an arrayref or a single string, and returns () |
913 | if there is no grouping. |
fa6b598f |
914 | |
915 | =cut |
335ed892 |
916 | |
fa6b598f |
917 | sub _grouping_columns { |
335ed892 |
918 | my ($self) = @_; |
919 | my $col = $self->grouping_column(); |
920 | if ( ref $col eq 'ARRAY' ) { |
921 | return @$col; |
922 | } elsif ($col) { |
923 | return ($col); |
924 | } else { |
925 | return (); |
926 | } |
7a76f44c |
927 | } |
928 | |
bd7ca9e8 |
929 | =head2 _is_in_group |
fa6b598f |
930 | |
931 | $item->_is_in_group( {user => 'fred', list => 'work'} ) |
932 | |
933 | Returns true if the object is in the group represented by hashref $other |
bd7ca9e8 |
934 | |
fa6b598f |
935 | =cut |
bd7ca9e8 |
936 | |
335ed892 |
937 | sub _is_in_group { |
938 | my ( $self, $other ) = @_; |
939 | my $current = { $self->_grouping_clause }; |
940 | |
941 | no warnings qw/uninitialized/; |
942 | |
943 | return 0 |
944 | if ( |
945 | join( "\x00", sort keys %$current ) ne join( "\x00", sort keys %$other ) ); |
946 | for my $key ( keys %$current ) { |
947 | return 0 if $current->{$key} ne $other->{$key}; |
948 | } |
949 | return 1; |
fa6b598f |
950 | } |
951 | |
b250066f |
952 | =head2 _ordered_internal_update |
953 | |
954 | This is a short-circuited method, that is used internally by this |
955 | module to update positioning values in isolation (i.e. without |
956 | triggering any of the positioning integrity code). |
957 | |
f045efad |
958 | Some day you might get confronted by datasets that have ambiguous |
48580715 |
959 | positioning data (e.g. duplicate position values within the same group, |
b250066f |
960 | in a table without unique constraints). When manually fixing such data |
961 | keep in mind that you can not invoke L<DBIx::Class::Row/update> like |
f045efad |
962 | you normally would, as it will get confused by the wrong data before |
b250066f |
963 | having a chance to update the ill-defined row. If you really know what |
f045efad |
964 | you are doing use this method which bypasses any hooks introduced by |
b250066f |
965 | this module. |
966 | |
967 | =cut |
968 | |
bd7ca9e8 |
969 | sub _ordered_internal_update { |
335ed892 |
970 | my $self = shift; |
971 | local $self->{_ORDERED_INTERNAL_UPDATE} = 1; |
972 | return $self->update(@_); |
973 | } |
974 | |
975 | =head2 table |
976 | |
977 | Overridden to provide a resultset class to override delete and update methods. |
978 | |
979 | Shamelessly stolen from InflateColumn::FS |
980 | |
981 | =cut |
982 | |
983 | sub table { |
984 | my $self = shift; |
985 | warn "**INSIDE Ordered->table**"; |
986 | my $ret = $self->next::method(@_); |
987 | $self->result_source_instance->resultset_class( |
988 | 'DBIx::Class::Ordered::ResultSet'); |
989 | return $ret; |
bd7ca9e8 |
990 | } |
fa6b598f |
991 | |
7a76f44c |
992 | 1; |
118e6b96 |
993 | |
bd7ca9e8 |
994 | __END__ |
dc66dea1 |
995 | |
bd7ca9e8 |
996 | =head1 CAVEATS |
dc66dea1 |
997 | |
65285cf7 |
998 | =head2 Resultset Methods |
999 | |
1000 | Note that all Insert/Create/Delete overrides are happening on |
1001 | L<DBIx::Class::Row> methods only. If you use the |
1002 | L<DBIx::Class::ResultSet> versions of |
1003 | L<update|DBIx::Class::ResultSet/update> or |
1004 | L<delete|DBIx::Class::ResultSet/delete>, all logic present in this |
1005 | module will be bypassed entirely (possibly resulting in a broken |
1006 | order-tree). Instead always use the |
1007 | L<update_all|DBIx::Class::ResultSet/update_all> and |
1008 | L<delete_all|DBIx::Class::ResultSet/delete_all> methods, which will |
1009 | invoke the corresponding L<row|DBIx::Class::Row> method on every |
1010 | member of the given resultset. |
1011 | |
133dd22a |
1012 | =head2 Race Condition on Insert |
1013 | |
65285cf7 |
1014 | If a position is not specified for an insert, a position |
bd7ca9e8 |
1015 | will be chosen based either on L</_initial_position_value> or |
1016 | L</_next_position_value>, depending if there are already some |
1017 | items in the current group. The space of time between the |
1018 | necessary selects and insert introduces a race condition. |
1019 | Having unique constraints on your position/group columns, |
1020 | and using transactions (see L<DBIx::Class::Storage/txn_do>) |
1021 | will prevent such race conditions going undetected. |
118e6b96 |
1022 | |
133dd22a |
1023 | =head2 Multiple Moves |
1024 | |
48580715 |
1025 | Be careful when issuing move_* methods to multiple objects. If |
133dd22a |
1026 | you've pre-loaded the objects then when you move one of the objects |
1027 | the position of the other object will not reflect their new value |
bd7ca9e8 |
1028 | until you reload them from the database - see |
1029 | L<DBIx::Class::Row/discard_changes>. |
133dd22a |
1030 | |
dc66dea1 |
1031 | There are times when you will want to move objects as groups, such |
48580715 |
1032 | as changing the parent of several objects at once - this directly |
133dd22a |
1033 | conflicts with this problem. One solution is for us to write a |
1034 | ResultSet class that supports a parent() method, for example. Another |
1035 | solution is to somehow automagically modify the objects that exist |
1036 | in the current object's result set to have the new position value. |
1037 | |
58755bba |
1038 | =head2 Default Values |
1039 | |
1040 | Using a database defined default_value on one of your group columns |
1041 | could result in the position not being assigned correctly. |
1042 | |
118e6b96 |
1043 | =head1 AUTHOR |
1044 | |
8f535707 |
1045 | Original code framework |
1046 | Aran Deltac <bluefeet@cpan.org> |
1047 | |
1048 | Constraints support and code generalisation |
1049 | Peter Rabbitson <ribasushi@cpan.org> |
118e6b96 |
1050 | |
335ed892 |
1051 | C<update> and C<delete> fix |
1052 | Devin Austin <dhoss@cpan.org> |
1053 | |
118e6b96 |
1054 | =head1 LICENSE |
1055 | |
1056 | You may distribute this code under the same terms as Perl itself. |
1057 | |