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