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