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