Add an explicit Sub::Quote dep in ::_Util
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Ordered.pm
1 package DBIx::Class::Ordered;
2 use strict;
3 use warnings;
4 use base qw( DBIx::Class );
5
6 =head1 NAME
7
8 DBIx::Class::Ordered - Modify the position of objects in an ordered list.
9
10 =head1 SYNOPSIS
11
12 Create a table for your ordered data.
13
14   CREATE TABLE items (
15     item_id INTEGER PRIMARY KEY AUTOINCREMENT,
16     name TEXT NOT NULL,
17     position INTEGER NOT NULL
18   );
19
20 Optionally, add one or more columns to specify groupings, allowing you
21 to maintain independent ordered lists within one table:
22
23   CREATE TABLE items (
24     item_id INTEGER PRIMARY KEY AUTOINCREMENT,
25     name TEXT NOT NULL,
26     position INTEGER NOT NULL,
27     group_id INTEGER NOT NULL
28   );
29
30 Or even
31
32   CREATE TABLE items (
33     item_id INTEGER PRIMARY KEY AUTOINCREMENT,
34     name TEXT NOT NULL,
35     position INTEGER NOT NULL,
36     group_id INTEGER NOT NULL,
37     other_group_id INTEGER NOT NULL
38   );
39
40 In your Schema or DB class add "Ordered" to the top
41 of the component list.
42
43   __PACKAGE__->load_components(qw( Ordered ... ));
44
45 Specify the column that stores the position number for
46 each row.
47
48   package My::Item;
49   __PACKAGE__->position_column('position');
50
51 If you are using one grouping column, specify it as follows:
52
53   __PACKAGE__->grouping_column('group_id');
54
55 Or if you have multiple grouping columns:
56
57   __PACKAGE__->grouping_column(['group_id', 'other_group_id']);
58
59 That's it, now you can change the position of your objects.
60
61   #!/use/bin/perl
62   use My::Item;
63
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 });
67
68   my $rs = $item->siblings();
69   my @siblings = $item->siblings();
70
71   my $sibling;
72   $sibling = $item->first_sibling();
73   $sibling = $item->last_sibling();
74   $sibling = $item->previous_sibling();
75   $sibling = $item->next_sibling();
76
77   $item->move_previous();
78   $item->move_next();
79   $item->move_first();
80   $item->move_last();
81   $item->move_to( $position );
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 );
86
87 =head1 DESCRIPTION
88
89 This module provides a simple interface for modifying the ordered
90 position of DBIx::Class objects.
91
92 =head1 AUTO UPDATE
93
94 All of the move_* methods automatically update the rows involved in
95 the query.  This is not configurable and is due to the fact that if you
96 move a record it always causes other records in the list to be updated.
97
98 =head1 METHODS
99
100 =head2 position_column
101
102   __PACKAGE__->position_column('position');
103
104 Sets and retrieves the name of the column that stores the
105 positional value of each record.  Defaults to "position".
106
107 =cut
108
109 __PACKAGE__->mk_classaccessor( 'position_column' => 'position' );
110
111 =head2 grouping_column
112
113   __PACKAGE__->grouping_column('group_id');
114
115 This method specifies a column to limit all queries in
116 this module by.  This effectively allows you to have multiple
117 ordered lists within the same table.
118
119 =cut
120
121 __PACKAGE__->mk_group_accessors( inherited => 'grouping_column' );
122
123 =head2 null_position_value
124
125   __PACKAGE__->null_position_value(undef);
126
127 This method specifies a value of L</position_column> which B<would
128 never be assigned to a row> during normal operation. When
129 a row is moved, its position is set to this value temporarily, so
130 that any unique constraints can not be violated. This value defaults
131 to 0, which should work for all cases except when your positions do
132 indeed start from 0.
133
134 =cut
135
136 __PACKAGE__->mk_classaccessor( 'null_position_value' => 0 );
137
138 =head2 siblings
139
140   my $rs = $item->siblings();
141   my @siblings = $item->siblings();
142
143 Returns an B<ordered> resultset of all other objects in the same
144 group excluding the one you called it on.
145
146 The ordering is a backwards-compatibility artifact - if you need
147 a resultset with no ordering applied use C<_siblings>
148
149 =cut
150 sub siblings {
151     my $self = shift;
152     return $self->_siblings->search ({}, { order_by => $self->position_column } );
153 }
154
155 =head2 previous_siblings
156
157   my $prev_rs = $item->previous_siblings();
158   my @prev_siblings = $item->previous_siblings();
159
160 Returns a resultset of all objects in the same group
161 positioned before the object on which this method was called.
162
163 =cut
164 sub 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     );
172 }
173
174 =head2 next_siblings
175
176   my $next_rs = $item->next_siblings();
177   my @next_siblings = $item->next_siblings();
178
179 Returns a resultset of all objects in the same group
180 positioned after the object on which this method was called.
181
182 =cut
183 sub 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     );
191 }
192
193 =head2 previous_sibling
194
195   my $sibling = $item->previous_sibling();
196
197 Returns the sibling that resides one position back.  Returns 0
198 if the current object is the first one.
199
200 =cut
201
202 sub previous_sibling {
203     my $self = shift;
204     my $position_column = $self->position_column;
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
218 Returns the first sibling object, or 0 if the first sibling
219 is this sibling.
220
221 =cut
222
223 sub 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;
233 }
234
235 =head2 next_sibling
236
237   my $sibling = $item->next_sibling();
238
239 Returns the sibling that resides one position forward. Returns 0
240 if the current object is the last one.
241
242 =cut
243
244 sub next_sibling {
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
259 Returns the last sibling, or 0 if the last sibling is this
260 sibling.
261
262 =cut
263
264 sub last_sibling {
265     my $self = shift;
266     my $position_column = $self->position_column;
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;
273 }
274
275 # an optimized method to get the last sibling position value without inflating a result object
276 sub _last_sibling_posval {
277     my $self = shift;
278     my $position_column = $self->position_column;
279
280     my $cursor = $self->next_siblings->search(
281         {},
282         { rows => 1, order_by => { '-desc' => $position_column }, select => $position_column },
283     )->cursor;
284
285     my ($pos) = $cursor->next;
286     return $pos;
287 }
288
289 =head2 move_previous
290
291   $item->move_previous();
292
293 Swaps position with the sibling in the position previous in
294 the list.  Returns 1 on success, and 0 if the object is
295 already the first one.
296
297 =cut
298
299 sub move_previous {
300     my $self = shift;
301     return $self->move_to ($self->_position - 1);
302 }
303
304 =head2 move_next
305
306   $item->move_next();
307
308 Swaps position with the sibling in the next position in the
309 list.  Returns 1 on success, and 0 if the object is already
310 the last in the list.
311
312 =cut
313
314 sub move_next {
315     my $self = shift;
316     return 0 unless defined $self->_last_sibling_posval;  # quick way to check for no more siblings
317     return $self->move_to ($self->_position + 1);
318 }
319
320 =head2 move_first
321
322   $item->move_first();
323
324 Moves the object to the first position in the list.  Returns 1
325 on success, and 0 if the object is already the first.
326
327 =cut
328
329 sub move_first {
330     return shift->move_to( 1 );
331 }
332
333 =head2 move_last
334
335   $item->move_last();
336
337 Moves the object to the last position in the list.  Returns 1
338 on success, and 0 if the object is already the last one.
339
340 =cut
341
342 sub move_last {
343     my $self = shift;
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) );
349 }
350
351 =head2 move_to
352
353   $item->move_to( $position );
354
355 Moves the object to the specified position.  Returns 1 on
356 success, and 0 if the object is already at the specified
357 position.
358
359 =cut
360
361 sub move_to {
362     my( $self, $to_position ) = @_;
363     return 0 if ( $to_position < 1 );
364
365     my $position_column = $self->position_column;
366
367     my $rsrc = $self->result_source;
368
369     my $is_txn;
370     if ($is_txn = $rsrc->schema->storage->transaction_depth) {
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,
380         (  $rsrc->resultset
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) ) {
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});
395       delete $self->{_dirty_columns}{$position_column};
396     }
397
398     my $from_position = $self->_position;
399
400     if ( $from_position == $to_position ) {   # FIXME this will not work for non-numeric order
401       return 0;
402     }
403
404     my $guard = $is_txn ? undef : $rsrc->schema->txn_scope_guard;
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     }
415
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
419     if (grep { $_ eq $position_column } ( map { @$_ } (values %{{ $rsrc->unique_constraints }} ) ) ) {
420       $self->_ordered_internal_update({ $position_column => $self->null_position_value });
421     }
422
423     $self->_shift_siblings ($direction, @between);
424     $self->_ordered_internal_update({ $position_column => $new_pos_val });
425
426     $guard->commit if $guard;
427     return 1;
428 }
429
430 =head2 move_to_group
431
432   $item->move_to_group( $group, $position );
433
434 Moves the object to the specified position of the specified
435 group, or to the end of the group if $position is undef.
436 1 is returned on success, and 0 is returned if the object is
437 already at the specified position of the specified group.
438
439 $group may be specified as a single scalar if only one
440 grouping column is in use, or as a hashref of column => value pairs
441 if multiple grouping columns are in use.
442
443 =cut
444
445 sub move_to_group {
446     my( $self, $to_group, $to_position ) = @_;
447
448     # if we're given a single value, turn it into a hashref
449     unless (ref $to_group eq 'HASH') {
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};
454     }
455
456     my $position_column = $self->position_column;
457
458     return 0 if ( defined($to_position) and $to_position < 1 );
459
460     # check if someone changed the _grouping_columns - this will
461     # prevent _is_in_group working, so we need to restore the
462     # original stashed values
463     for ($self->_grouping_columns) {
464       if ($self->is_column_changed ($_)) {
465         $self->store_column($_, delete $self->{_column_data_in_storage}{$_});
466         delete $self->{_dirty_columns}{$_};
467       }
468     }
469
470     if ($self->_is_in_group ($to_group) ) {
471       my $ret;
472       if (defined $to_position) {
473         $ret = $self->move_to ($to_position);
474       }
475
476       return $ret||0;
477     }
478
479     my $guard = $self->result_source->schema->txn_scope_guard;
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     );
489
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       );
496     }
497     else {
498       my $bumped_pos_val = $self->_position_value ($to_position);
499       my @between = map { $self->_position_value ($_) } ($to_position, $new_group_last_position);
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;
509 }
510
511 =head2 insert
512
513 Overrides the DBIC insert() method by providing a default
514 position number.  The default will be the number of rows in
515 the table +1, thus positioning the new record at the last position.
516
517 =cut
518
519 sub insert {
520     my $self = shift;
521     my $position_column = $self->position_column;
522
523     unless ($self->get_column($position_column)) {
524         my $lsib_posval = $self->_last_sibling_posval;
525         $self->set_column(
526             $position_column => (defined $lsib_posval
527                 ? $self->_next_position_value ( $lsib_posval )
528                 : $self->_initial_position_value
529             )
530         );
531     }
532
533     return $self->next::method( @_ );
534 }
535
536 =head2 update
537
538 Overrides the DBIC update() method by checking for a change
539 to the position and/or group columns.  Movement within a
540 group or to another group is handled by repositioning
541 the appropriate siblings.  Position defaults to the end
542 of a new group if it has been changed to undef.
543
544 =cut
545
546 sub update {
547   my $self = shift;
548
549   # this is set by _ordered_internal_update()
550   return $self->next::method(@_) if $self->result_source->schema->{_ORDERED_INTERNAL_UPDATE};
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   }
565   elsif (grep { exists $changed_ordering_cols->{$_} } @group_columns ) {
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   }
586
587   return $self;
588 }
589
590 =head2 delete
591
592 Overrides the DBIC delete() method by first moving the object
593 to the last position, then deleting it, thus ensuring the
594 integrity of the positions.
595
596 =cut
597
598 sub delete {
599     my $self = shift;
600
601     my $guard = $self->result_source->schema->txn_scope_guard;
602
603     $self->move_last;
604
605     $self->next::method( @_ );
606
607     $guard->commit;
608
609     return $self;
610 }
611
612 # add the current position/group to the things we track old values for
613 sub _track_storage_value {
614   my ($self, $col) = @_;
615   return (
616     $self->next::method($col)
617       ||
618     grep { $_ eq $col } ($self->position_column, $self->_grouping_columns)
619   );
620 }
621
622 =head1 METHODS FOR EXTENDING ORDERED
623
624 You would want to override the methods below if you use sparse
625 (non-linear) or non-numeric position values. This can be useful
626 if you are working with preexisting non-normalised position data,
627 or if you need to work with materialized path columns.
628
629 =head2 _position_from_value
630
631   my $num_pos = $item->_position_from_value ( $pos_value )
632
633 Returns the B<absolute numeric position> of an object with a B<position
634 value> set to C<$pos_value>. By default simply returns C<$pos_value>.
635
636 =cut
637 sub _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
650 =head2 _position_value
651
652   my $pos_value = $item->_position_value ( $pos )
653
654 Returns the B<value> of L</position_column> of the object at numeric
655 position C<$pos>. By default simply returns C<$pos>.
656
657 =cut
658 sub _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
676 This method specifies a B<value> of L</position_column> which is assigned
677 to the first inserted element of a group, if no value was supplied at
678 insertion time. All subsequent values are derived from this one by
679 L</_next_position_value> below. Defaults to 1.
680
681 =cut
682
683 __PACKAGE__->mk_classaccessor( '_initial_position_value' => 1 );
684
685 =head2 _next_position_value
686
687   my $new_value = $item->_next_position_value ( $position_value )
688
689 Returns a position B<value> that would be considered C<next> with
690 regards to C<$position_value>. Can be pretty much anything, given
691 that C<< $position_value < $new_value >> where C<< < >> is the
692 SQL comparison operator (usually works fine on strings). The
693 default method expects C<$position_value> to be numeric, and
694 returns C<$position_value + 1>
695
696 =cut
697 sub _next_position_value {
698     return $_[1] + 1;
699 }
700
701 =head2 _shift_siblings
702
703   $item->_shift_siblings ($direction, @between)
704
705 Shifts 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
708 L</position_column> value by 1, doing so in a way as to not violate
709 any existing constraints.
710
711 Note that if you override this method and have unique constraints
712 including the L</position_column> the shift is not a trivial task.
713 Refer to the implementation source of the default method for more
714 information.
715
716 =cut
717 sub _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
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 (
745       grep { $_ eq $position_column } ( map { @$_ } (values %{{ $rsrc->unique_constraints }} ) )
746     ) {
747         my $clean_rs = $rsrc->resultset;
748
749         for ( $shift_rs->search (
750           {}, { order_by => { "-$ord", $position_column }, select => [$position_column, @pcols] }
751         )->cursor->all ) {
752           my $pos = shift @$_;
753           $clean_rs->find(@$_)->update ({ $position_column => $pos + ( ($op eq '+') ? 1 : -1 ) });
754         }
755     }
756     else {
757         $shift_rs->update ({ $position_column => \ "$position_column $op 1" } );
758     }
759 }
760
761
762 # This method returns a resultset containing all members of the row
763 # group (including the row itself).
764 sub _group_rs {
765     my $self = shift;
766     return $self->result_source->resultset->search({$self->_grouping_clause()});
767 }
768
769 # Returns an unordered resultset of all objects in the same group
770 # excluding the object you called this method on.
771 sub _siblings {
772     my $self = shift;
773     my $position_column = $self->position_column;
774     my $pos;
775     return defined ($pos = $self->get_column($position_column))
776         ? $self->_group_rs->search(
777             { $position_column => { '!=' => $pos } },
778           )
779         : $self->_group_rs
780     ;
781 }
782
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.
785 sub _position {
786     my $self = shift;
787     return $self->_position_from_value ($self->get_column ($self->position_column) );
788 }
789
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.
793 sub _grouping_clause {
794     my( $self ) = @_;
795     return map {  $_ => $self->get_column($_)  } $self->_grouping_columns();
796 }
797
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.
801 sub _grouping_columns {
802     my( $self ) = @_;
803     my $col = $self->grouping_column();
804     if (ref $col eq 'ARRAY') {
805         return @$col;
806     } elsif ($col) {
807         return ( $col );
808     } else {
809         return ();
810     }
811 }
812
813 # Returns true if the object is in the group represented by hashref $other
814 sub _is_in_group {
815     my ($self, $other) = @_;
816     my $current = {$self->_grouping_clause};
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     );
825     for my $key (keys %$current) {
826         return 0 if $current->{$key} ne $other->{$key};
827     }
828     return 1;
829 }
830
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.
843 sub _ordered_internal_update {
844     my $self = shift;
845     local $self->result_source->schema->{_ORDERED_INTERNAL_UPDATE} = 1;
846     return $self->update (@_);
847 }
848
849 1;
850
851 __END__
852
853 =head1 CAVEATS
854
855 =head2 Resultset Methods
856
857 Note that all Insert/Create/Delete overrides are happening on
858 L<DBIx::Class::Row> methods only. If you use the
859 L<DBIx::Class::ResultSet> versions of
860 L<update|DBIx::Class::ResultSet/update> or
861 L<delete|DBIx::Class::ResultSet/delete>, all logic present in this
862 module will be bypassed entirely (possibly resulting in a broken
863 order-tree). Instead always use the
864 L<update_all|DBIx::Class::ResultSet/update_all> and
865 L<delete_all|DBIx::Class::ResultSet/delete_all> methods, which will
866 invoke the corresponding L<row|DBIx::Class::Row> method on every
867 member of the given resultset.
868
869 =head2 Race Condition on Insert
870
871 If a position is not specified for an insert, a position
872 will be chosen based either on L</_initial_position_value> or
873 L</_next_position_value>, depending if there are already some
874 items in the current group. The space of time between the
875 necessary selects and insert introduces a race condition.
876 Having unique constraints on your position/group columns,
877 and using transactions (see L<DBIx::Class::Storage/txn_do>)
878 will prevent such race conditions going undetected.
879
880 =head2 Multiple Moves
881
882 If you have multiple same-group result objects already loaded from storage,
883 you need to be careful when executing C<move_*> operations on them:
884 without a L</position_column> reload the L</_position_value> of the
885 "siblings" will be out of sync with the underlying storage.
886
887 Starting from version C<0.082800> DBIC will implicitly perform such
888 reloads 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
891 If it is not possible for you to wrap the entire call-chain in a transaction,
892 you will need to call L<DBIx::Class::Row/discard_changes> to get an object
893 up-to-date before proceeding, otherwise undefined behavior will result.
894
895 =head2 Default Values
896
897 Using a database defined default_value on one of your group columns
898 could result in the position not being assigned correctly.
899
900 =head1 FURTHER QUESTIONS?
901
902 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
903
904 =head1 COPYRIGHT AND LICENSE
905
906 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
907 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
908 redistribute it and/or modify it under the same terms as the
909 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.