Applied patch from kados regarding use of a DateTime::Format class to validate
[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_classdata( '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_classdata( '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 constrainst 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_classdata( '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 L</_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 row 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 $from_position = $self->_position;
366     return 0 if ( $from_position == $to_position );
367
368     my $position_column = $self->position_column;
369
370     {
371         my $guard = $self->result_source->schema->txn_scope_guard;
372
373         my ($direction, @between);
374         if ( $from_position < $to_position ) {
375             $direction = -1;
376             @between = map { $self->_position_value ($_) } ( $from_position + 1, $to_position );
377         }
378         else {
379             $direction = 1;
380             @between = map { $self->_position_value ($_) } ( $to_position, $from_position - 1 );
381         }
382
383         my $new_pos_val = $self->_position_value ($to_position);                              # record this before the shift
384
385         # we need to null-position the moved row if the position column is part of a constraint
386         if (grep { $_ eq $position_column } ( map { @$_ } (values %{{ $self->result_source->unique_constraints }} ) ) ) {
387             $self->_ordered_internal_update({ $position_column => $self->null_position_value });
388         }
389
390         $self->_shift_siblings ($direction, @between);
391         $self->_ordered_internal_update({ $position_column => $new_pos_val });
392
393         $guard->commit;
394
395         return 1;
396     }
397 }
398
399 =head2 move_to_group
400
401   $item->move_to_group( $group, $position );
402
403 Moves the object to the specified position of the specified
404 group, or to the end of the group if $position is undef.
405 1 is returned on success, and 0 is returned if the object is
406 already at the specified position of the specified group.
407
408 $group may be specified as a single scalar if only one 
409 grouping column is in use, or as a hashref of column => value pairs
410 if multiple grouping columns are in use.
411
412 =cut
413
414 sub move_to_group {
415     my( $self, $to_group, $to_position ) = @_;
416
417     $self->throw_exception ('move_to_group() expects a group specification')
418         unless defined $to_group;
419
420     # if we're given a string, turn it into a hashref
421     unless (ref $to_group eq 'HASH') {
422         my @gcols = $self->_grouping_columns;
423
424         $self->throw_exception ('Single group supplied for a multi-column group identifier') if @gcols > 1;
425         $to_group = {$gcols[0] => $to_group};
426     }
427
428     my $position_column = $self->position_column;
429
430     return 0 if ( defined($to_position) and $to_position < 1 );
431     if ($self->_is_in_group ($to_group) ) {
432         return 0 if not defined $to_position;
433         return $self->move_to ($to_position);
434     }
435
436     {
437         my $guard = $self->result_source->schema->txn_scope_guard;
438
439         # Move to end of current group to adjust siblings
440         $self->move_last;
441
442         $self->set_inflated_columns({ %$to_group, $position_column => undef });
443         my $new_group_last_posval = $self->_last_sibling_posval;
444         my $new_group_last_position = $self->_position_from_value (
445           $new_group_last_posval
446         );
447
448         if ( not defined($to_position) or $to_position > $new_group_last_position) {
449             $self->set_column(
450                 $position_column => $new_group_last_position
451                     ? $self->_next_position_value ( $new_group_last_posval )
452                     : $self->_initial_position_value
453             );
454         }
455         else {
456             my $bumped_pos_val = $self->_position_value ($to_position);
457             my @between = ($to_position, $new_group_last_position);
458             $self->_shift_siblings (1, @between);   #shift right
459             $self->set_column( $position_column => $bumped_pos_val );
460         }
461
462         $self->_ordered_internal_update;
463
464         $guard->commit;
465
466         return 1;
467     }
468 }
469
470 =head2 insert
471
472 Overrides the DBIC insert() method by providing a default 
473 position number.  The default will be the number of rows in 
474 the table +1, thus positioning the new record at the last position.
475
476 =cut
477
478 sub insert {
479     my $self = shift;
480     my $position_column = $self->position_column;
481
482     unless ($self->get_column($position_column)) {
483         my $lsib_posval = $self->_last_sibling_posval;
484         $self->set_column(
485             $position_column => (defined $lsib_posval
486                 ? $self->_next_position_value ( $lsib_posval )
487                 : $self->_initial_position_value
488             )
489         );
490     }
491
492     return $self->next::method( @_ );
493 }
494
495 =head2 update
496
497 Overrides the DBIC update() method by checking for a change
498 to the position and/or group columns.  Movement within a
499 group or to another group is handled by repositioning
500 the appropriate siblings.  Position defaults to the end
501 of a new group if it has been changed to undef.
502
503 =cut
504
505 sub update {
506     my $self = shift;
507
508     # this is set by _ordered_internal_update()
509     return $self->next::method(@_) if $self->{_ORDERED_INTERNAL_UPDATE};
510
511     my $upd = shift;
512     $self->set_inflated_columns($upd) if $upd;
513     my %changes = $self->get_dirty_columns;
514     $self->discard_changes;
515
516     my $position_column = $self->position_column;
517
518     # if nothing group/position related changed - short circuit
519     if (not grep { exists $changes{$_} } ($self->_grouping_columns, $position_column) ) {
520         return $self->next::method( \%changes, @_ );
521     }
522
523     {
524         my $guard = $self->result_source->schema->txn_scope_guard;
525
526         # if any of our grouping columns have been changed
527         if (grep { exists $changes{$_} } ($self->_grouping_columns) ) {
528
529             # create new_group by taking the current group and inserting changes
530             my $new_group = {$self->_grouping_clause};
531             foreach my $col (keys %$new_group) {
532                 if (exists $changes{$col}) {
533                     $new_group->{$col} = delete $changes{$col}; # don't want to pass this on to next::method
534                 }
535             }
536
537             $self->move_to_group(
538                 $new_group,
539                 (exists $changes{$position_column}
540                     # The FIXME bit contradicts the documentation: when changing groups without supplying explicit
541                     # positions in move_to_group(), we push the item to the end of the group.
542                     # However when I was rewriting this, the position from the old group was clearly passed to the new one
543                     # Probably needs to go away (by ribasushi)
544                     ? delete $changes{$position_column}     # means there was a position change supplied with the update too
545                     : $self->_position                      # FIXME!
546                 ),
547             );
548         }
549         elsif (exists $changes{$position_column}) {
550             $self->move_to(delete $changes{$position_column});
551         }
552
553         my @res;
554         my $want = wantarray();
555         if (not defined $want) {
556             $self->next::method( \%changes, @_ );
557         }
558         elsif ($want) {
559             @res = $self->next::method( \%changes, @_ );
560         }
561         else {
562             $res[0] = $self->next::method( \%changes, @_ );
563         }
564
565         $guard->commit;
566         return $want ? @res : $res[0];
567     }
568 }
569
570 =head2 delete
571
572 Overrides the DBIC delete() method by first moving the object 
573 to the last position, then deleting it, thus ensuring the
574 integrity of the positions.
575
576 =cut
577
578 sub delete {
579     my $self = shift;
580
581     my $guard = $self->result_source->schema->txn_scope_guard;
582
583     $self->move_last;
584
585     my @res;
586     my $want = wantarray();
587     if (not defined $want) {
588         $self->next::method( @_ );
589     }
590     elsif ($want) {
591         @res = $self->next::method( @_ );
592     }
593     else {
594         $res[0] = $self->next::method( @_ );
595     }
596
597     $guard->commit;
598     return $want ? @res : $res[0];
599 }
600
601 =head1 METHODS FOR EXTENDING ORDERED
602
603 You would want to override the methods below if you use sparse
604 (non-linear) or non-numeric position values. This can be useful
605 if you are working with preexisting non-normalised position data,
606 or if you need to work with materialized path columns.
607
608 =head2 _position
609
610   my $num_pos = $item->_position;
611
612 Returns the B<absolute numeric position> of the current object, with the
613 first object being at position 1, its sibling at position 2 and so on.
614 By default simply returns the value of L</position_column>.
615
616 =cut
617 sub _position {
618     my $self = shift;
619
620 #    #the right way to do this
621 #    return $self->previous_siblings->count + 1;
622
623     return $self->get_column ($self->position_column);
624 }
625
626 =head2 _position_from_value
627
628   my $num_pos = $item->_position_of_value ( $pos_value )
629
630 Returns the B<absolute numeric position> of an object with a B<position
631 value> set to C<$pos_value>. By default simply returns C<$pos_value>.
632
633 =cut
634 sub _position_from_value {
635     my ($self, $val) = @_;
636
637     return 0 unless defined $val;
638
639 #    #the right way to do this
640 #    return $self -> _group_rs
641 #                 -> search({ $self->position_column => { '<=', $val } })
642 #                 -> count
643
644     return $val;
645 }
646
647 =head2 _position_value
648
649   my $pos_value = $item->_position_value ( $pos )
650
651 Returns the B<value> of L</position_column> of the object at numeric
652 position C<$pos>. By default simply returns C<$pos>.
653
654 =cut
655 sub _position_value {
656     my ($self, $pos) = @_;
657
658 #    #the right way to do this (not optimized)
659 #    my $position_column = $self->position_column;
660 #    return $self -> _group_rs
661 #                 -> search({}, { order_by => $position_column })
662 #                 -> slice ( $pos - 1)
663 #                 -> single
664 #                 -> get_column ($position_column);
665
666     return $pos;
667 }
668
669 =head2 _initial_position_value
670
671   __PACKAGE__->_initial_position_value(0);
672
673 This method specifies a B<value> of L</position_column> which is assigned
674 to the first inserted element of a group, if no value was supplied at
675 insertion time. All subsequent values are derived from this one by
676 L</_next_position_value> below. Defaults to 1.
677
678 =cut
679
680 __PACKAGE__->mk_classdata( '_initial_position_value' => 1 );
681
682 =head2 _next_position_value
683
684   my $new_value = $item->_next_position_value ( $position_value )
685
686 Returns a position B<value> that would be considered C<next> with
687 regards to C<$position_value>. Can be pretty much anything, given
688 that C<< $position_value < $new_value >> where C<< < >> is the
689 SQL comparison operator (usually works fine on strings). The
690 default method expects C<$position_value> to be numeric, and
691 returns C<$position_value + 1>
692
693 =cut
694 sub _next_position_value {
695     return $_[1] + 1;
696 }
697
698 =head2 _shift_siblings
699
700   $item->_shift_siblings ($direction, @between)
701
702 Shifts all siblings with B<positions values> in the range @between
703 (inclusive) by one position as specified by $direction (left if < 0,
704  right if > 0). By default simply increments/decrements each
705 L<position_column> value by 1, doing so in a way as to not violate
706 any existing constraints.
707
708 Note that if you override this method and have unique constraints
709 including the L<position_column> the shift is not a trivial task.
710 Refer to the implementation source of the default method for more
711 information.
712
713 =cut
714 sub _shift_siblings {
715     my ($self, $direction, @between) = @_;
716     return 0 unless $direction;
717
718     my $position_column = $self->position_column;
719
720     my ($op, $ord);
721     if ($direction < 0) {
722         $op = '-';
723         $ord = 'asc';
724     }
725     else {
726         $op = '+';
727         $ord = 'desc';
728     }
729
730     my $shift_rs = $self->_group_rs-> search ({ $position_column => { -between => \@between } });
731
732     # some databases (sqlite) are dumb and can not do a blanket
733     # increment/decrement. So what we do here is check if the
734     # position column is part of a unique constraint, and do a
735     # one-by-one update if this is the case
736
737     my $rsrc = $self->result_source;
738
739     if (grep { $_ eq $position_column } ( map { @$_ } (values %{{ $rsrc->unique_constraints }} ) ) ) {
740
741         my @pcols = $rsrc->primary_columns;
742         my $cursor = $shift_rs->search ({}, { order_by => { "-$ord", $position_column }, columns => \@pcols } )->cursor;
743         my $rs = $self->result_source->resultset;
744
745         while (my @pks = $cursor->next ) {
746
747           my $cond;
748           for my $i (0.. $#pcols) {
749             $cond->{$pcols[$i]} = $pks[$i];
750           }
751
752           $rs->search($cond)->update ({ $position_column => \ "$position_column $op 1" } );
753         }
754     }
755     else {
756         $shift_rs->update ({ $position_column => \ "$position_column $op 1" } );
757     }
758 }
759
760 =head1 PRIVATE METHODS
761
762 These methods are used internally.  You should never have the 
763 need to use them.
764
765 =head2 _group_rs
766
767 This method returns a resultset containing all members of the row
768 group (including the row itself).
769
770 =cut
771 sub _group_rs {
772     my $self = shift;
773     return $self->result_source->resultset->search({$self->_grouping_clause()});
774 }
775
776 =head2 _siblings
777
778 Returns an unordered resultset of all objects in the same group
779 excluding the object you called this method on.
780
781 =cut
782 sub _siblings {
783     my $self = shift;
784     my $position_column = $self->position_column;
785     return $self->_group_rs->search(
786         { $position_column => { '!=' => $self->get_column($position_column) } },
787     );
788 }
789
790 =head2 _grouping_clause
791
792 This method returns one or more name=>value pairs for limiting a search
793 by the grouping column(s).  If the grouping column is not
794 defined then this will return an empty list.
795
796 =cut
797 sub _grouping_clause {
798     my( $self ) = @_;
799     return map {  $_ => $self->get_column($_)  } $self->_grouping_columns();
800 }
801
802 =head2 _get_grouping_columns
803
804 Returns a list of the column names used for grouping, regardless of whether
805 they were specified as an arrayref or a single string, and returns ()
806 if there is no grouping.
807
808 =cut
809 sub _grouping_columns {
810     my( $self ) = @_;
811     my $col = $self->grouping_column();
812     if (ref $col eq 'ARRAY') {
813         return @$col;
814     } elsif ($col) {
815         return ( $col );
816     } else {
817         return ();
818     }
819 }
820
821 =head2 _is_in_group
822
823     $item->_is_in_group( {user => 'fred', list => 'work'} )
824
825 Returns true if the object is in the group represented by hashref $other
826
827 =cut
828 sub _is_in_group {
829     my ($self, $other) = @_;
830     my $current = {$self->_grouping_clause};
831
832     no warnings qw/uninitialized/;
833
834     return 0 if (
835         join ("\x00", sort keys %$current)
836             ne
837         join ("\x00", sort keys %$other)
838     );
839     for my $key (keys %$current) {
840         return 0 if $current->{$key} ne $other->{$key};
841     }
842     return 1;
843 }
844
845 =head2 _ordered_internal_update
846
847 This is a short-circuited method, that is used internally by this
848 module to update positioning values in isolation (i.e. without
849 triggering any of the positioning integrity code).
850
851 Some day you might get confronted by datasets that have ambiguous
852 positioning data (i.e. duplicate position values within the same group,
853 in a table without unique constraints). When manually fixing such data
854 keep in mind that you can not invoke L<DBIx::Class::Row/update> like
855 you normally would, as it will get confused by the wrong data before
856 having a chance to update the ill-defined row. If you really know what
857 you are doing use this method which bypasses any hooks introduced by
858 this module.
859
860 =cut
861
862 sub _ordered_internal_update {
863     my $self = shift;
864     local $self->{_ORDERED_INTERNAL_UPDATE} = 1;
865     return $self->update (@_);
866 }
867
868 1;
869
870 __END__
871
872 =head1 CAVEATS
873
874 =head2 Race Condition on Insert
875
876 If a position is not specified for an insert than a position 
877 will be chosen based either on L</_initial_position_value> or
878 L</_next_position_value>, depending if there are already some
879 items in the current group. The space of time between the
880 necessary selects and insert introduces a race condition.
881 Having unique constraints on your position/group columns,
882 and using transactions (see L<DBIx::Class::Storage/txn_do>)
883 will prevent such race conditions going undetected.
884
885 =head2 Multiple Moves
886
887 Be careful when issueing move_* methods to multiple objects.  If 
888 you've pre-loaded the objects then when you move one of the objects 
889 the position of the other object will not reflect their new value 
890 until you reload them from the database - see
891 L<DBIx::Class::Row/discard_changes>.
892
893 There are times when you will want to move objects as groups, such 
894 as changeing the parent of several objects at once - this directly 
895 conflicts with this problem.  One solution is for us to write a 
896 ResultSet class that supports a parent() method, for example.  Another 
897 solution is to somehow automagically modify the objects that exist 
898 in the current object's result set to have the new position value.
899
900 =head2 Default Values
901
902 Using a database defined default_value on one of your group columns
903 could result in the position not being assigned correctly.
904
905 =head1 AUTHOR
906
907  Original code framework
908    Aran Deltac <bluefeet@cpan.org>
909
910  Constraints support and code generalisation
911    Peter Rabbitson <ribasushi@cpan.org>
912
913 =head1 LICENSE
914
915 You may distribute this code under the same terms as Perl itself.
916