Using "is" instead of "cmp_ok"
[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
e9188247 20Optionally, add one or more columns to specify groupings, allowing you
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
a8492531 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
45Specify the column that stores the position number for
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;
118e6b96 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 });
118e6b96 67
a733c37f 68 my $rs = $item->siblings();
69 my @siblings = $item->siblings();
118e6b96 70
71 my $sibling;
a733c37f 72 $sibling = $item->first_sibling();
73 $sibling = $item->last_sibling();
74 $sibling = $item->previous_sibling();
75 $sibling = $item->next_sibling();
118e6b96 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
a733c37f 89This module provides a simple interface for modifying the ordered
90position of DBIx::Class objects.
118e6b96 91
133dd22a 92=head1 AUTO UPDATE
93
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
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
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
109__PACKAGE__->mk_classdata( 'position_column' => 'position' );
110
a733c37f 111=head2 grouping_column
133dd22a 112
a733c37f 113 __PACKAGE__->grouping_column('group_id');
133dd22a 114
a8492531 115This method specifies a column to limit all queries in
133dd22a 116this module by. This effectively allows you to have multiple
a733c37f 117ordered lists within the same table.
133dd22a 118
119=cut
120
a733c37f 121__PACKAGE__->mk_classdata( '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
130that any unique constrainst can not be violated. This value defaults
131to 0, which should work for all cases except when your positions do
132indeed start from 0.
133
134=cut
135
136__PACKAGE__->mk_classdata( 'null_position_value' => 0 );
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
147a resultset with no ordering applied use L</_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
218Returns the first sibling object, or 0 if the first sibling
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
259Returns the last sibling, or 0 if the last sibling is this
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
80010e2b 275=head2 move_previous
118e6b96 276
a733c37f 277 $item->move_previous();
118e6b96 278
a8492531 279Swaps position with the sibling in the position previous in
280the list. Returns 1 on success, and 0 if the object is
281already the first one.
118e6b96 282
283=cut
284
80010e2b 285sub move_previous {
bd7ca9e8 286 my $self = shift;
287 return $self->move_to ($self->_position - 1);
118e6b96 288}
289
80010e2b 290=head2 move_next
118e6b96 291
a733c37f 292 $item->move_next();
118e6b96 293
a8492531 294Swaps position with the sibling in the next position in the
295list. Returns 1 on success, and 0 if the object is already
296the last in the list.
118e6b96 297
298=cut
299
80010e2b 300sub move_next {
bd7ca9e8 301 my $self = shift;
302 return 0 unless $self->next_siblings->count;
303 return $self->move_to ($self->_position + 1);
118e6b96 304}
305
306=head2 move_first
307
a733c37f 308 $item->move_first();
118e6b96 309
a8492531 310Moves the object to the first position in the list. Returns 1
311on success, and 0 if the object is already the first.
118e6b96 312
313=cut
314
315sub move_first {
bd7ca9e8 316 return shift->move_to( 1 );
118e6b96 317}
318
319=head2 move_last
320
a733c37f 321 $item->move_last();
118e6b96 322
a8492531 323Moves the object to the last position in the list. Returns 1
324on success, and 0 if the object is already the last one.
118e6b96 325
326=cut
327
328sub move_last {
bd7ca9e8 329 my $self = shift;
330 return $self->move_to( $self->_group_rs->count );
118e6b96 331}
332
333=head2 move_to
334
a733c37f 335 $item->move_to( $position );
118e6b96 336
a8492531 337Moves the object to the specified position. Returns 1 on
338success, and 0 if the object is already at the specified
339position.
118e6b96 340
341=cut
342
343sub move_to {
344 my( $self, $to_position ) = @_;
133dd22a 345 return 0 if ( $to_position < 1 );
118e6b96 346
bd7ca9e8 347 my $from_position = $self->_position;
348 return 0 if ( $from_position == $to_position );
349
350 my $position_column = $self->position_column;
351
bd7ca9e8 352 {
8f535707 353 my $guard = $self->result_source->schema->txn_scope_guard;
354
bd7ca9e8 355 my ($direction, @between);
356 if ( $from_position < $to_position ) {
357 $direction = -1;
358 @between = map { $self->_position_value ($_) } ( $from_position + 1, $to_position );
359 }
360 else {
361 $direction = 1;
362 @between = map { $self->_position_value ($_) } ( $to_position, $from_position - 1 );
363 }
364
365 my $new_pos_val = $self->_position_value ($to_position); # record this before the shift
b250066f 366
367 # we need to null-position the moved row if the position column is part of a constraint
368 if (grep { $_ eq $position_column } ( map { @$_ } (values %{{ $self->result_source->unique_constraints }} ) ) ) {
369 $self->_ordered_internal_update({ $position_column => $self->null_position_value });
370 }
371
bd7ca9e8 372 $self->_shift_siblings ($direction, @between);
373 $self->_ordered_internal_update({ $position_column => $new_pos_val });
fa6b598f 374
8f535707 375 $guard->commit;
376
bd7ca9e8 377 return 1;
378 }
379}
fa6b598f 380
79dc353a 381=head2 move_to_group
382
383 $item->move_to_group( $group, $position );
384
385Moves the object to the specified position of the specified
386group, or to the end of the group if $position is undef.
3871 is returned on success, and 0 is returned if the object is
388already at the specified position of the specified group.
389
1d941d67 390$group may be specified as a single scalar if only one
391grouping column is in use, or as a hashref of column => value pairs
392if multiple grouping columns are in use.
fa6b598f 393
79dc353a 394=cut
395
396sub move_to_group {
397 my( $self, $to_group, $to_position ) = @_;
fa6b598f 398
bd7ca9e8 399 $self->throw_exception ('move_to_group() expects a group specification')
400 unless defined $to_group;
401
fa6b598f 402 # if we're given a string, turn it into a hashref
403 unless (ref $to_group eq 'HASH') {
bd7ca9e8 404 my @gcols = $self->_grouping_columns;
405
406 $self->throw_exception ('Single group supplied for a multi-column group identifier') if @gcols > 1;
407 $to_group = {$gcols[0] => $to_group};
fa6b598f 408 }
409
79dc353a 410 my $position_column = $self->position_column;
79dc353a 411
79dc353a 412 return 0 if ( defined($to_position) and $to_position < 1 );
bd7ca9e8 413 if ($self->_is_in_group ($to_group) ) {
414 return 0 if not defined $to_position;
415 return $self->move_to ($to_position);
79dc353a 416 }
417
bd7ca9e8 418 {
8f535707 419 my $guard = $self->result_source->schema->txn_scope_guard;
420
bd7ca9e8 421 # Move to end of current group to adjust siblings
422 $self->move_last;
423
424 $self->set_inflated_columns({ %$to_group, $position_column => undef });
425 my $new_group_count = $self->_group_rs->count;
426
427 if ( not defined($to_position) or $to_position > $new_group_count) {
428 $self->set_column(
429 $position_column => $new_group_count
430 ? $self->_next_position_value ( $self->last_sibling->get_column ($position_column) ) # FIXME - no need to inflate last_sibling
431 : $self->_initial_position_value
432 );
433 }
434 else {
435 my $bumped_pos_val = $self->_position_value ($to_position);
436 my @between = ($to_position, $new_group_count);
437 $self->_shift_siblings (1, @between); #shift right
438 $self->set_column( $position_column => $bumped_pos_val );
439 }
440
441 $self->_ordered_internal_update;
442
8f535707 443 $guard->commit;
444
bd7ca9e8 445 return 1;
446 }
79dc353a 447}
448
118e6b96 449=head2 insert
450
451Overrides the DBIC insert() method by providing a default
452position number. The default will be the number of rows in
453the table +1, thus positioning the new record at the last position.
454
455=cut
456
457sub insert {
458 my $self = shift;
459 my $position_column = $self->position_column;
bd7ca9e8 460
461 unless ($self->get_column($position_column)) {
462 my $lsib = $self->last_sibling; # FIXME - no need to inflate last_sibling
463 $self->set_column(
464 $position_column => ($lsib
465 ? $self->_next_position_value ( $lsib->get_column ($position_column) )
466 : $self->_initial_position_value
467 )
468 );
469 }
470
0a298c73 471 return $self->next::method( @_ );
118e6b96 472}
473
79dc353a 474=head2 update
475
476Overrides the DBIC update() method by checking for a change
477to the position and/or group columns. Movement within a
478group or to another group is handled by repositioning
479the appropriate siblings. Position defaults to the end
480of a new group if it has been changed to undef.
481
482=cut
483
484sub update {
485 my $self = shift;
486
bd7ca9e8 487 # this is set by _ordered_internal_update()
488 return $self->next::method(@_) if $self->{_ORDERED_INTERNAL_UPDATE};
79dc353a 489
bd7ca9e8 490 my $upd = shift;
491 $self->set_inflated_columns($upd) if $upd;
79dc353a 492 my %changes = $self->get_dirty_columns;
493 $self->discard_changes;
494
bd7ca9e8 495 my $position_column = $self->position_column;
fa6b598f 496
bd7ca9e8 497 # if nothing group/position related changed - short circuit
498 if (not grep { exists $changes{$_} } ($self->_grouping_columns, $position_column) ) {
499 return $self->next::method( \%changes, @_ );
500 }
fa6b598f 501
bd7ca9e8 502 {
8f535707 503 my $guard = $self->result_source->schema->txn_scope_guard;
504
bd7ca9e8 505 # if any of our grouping columns have been changed
506 if (grep { exists $changes{$_} } ($self->_grouping_columns) ) {
507
508 # create new_group by taking the current group and inserting changes
509 my $new_group = {$self->_grouping_clause};
510 foreach my $col (keys %$new_group) {
511 if (exists $changes{$col}) {
512 $new_group->{$col} = delete $changes{$col}; # don't want to pass this on to next::method
513 }
fa6b598f 514 }
bd7ca9e8 515
516 $self->move_to_group(
517 $new_group,
518 (exists $changes{$position_column}
519 # The FIXME bit contradicts the documentation: when changing groups without supplying explicit
520 # positions in move_to_group(), we push the item to the end of the group.
521 # However when I was rewriting this, the position from the old group was clearly passed to the new one
522 # Probably needs to go away (by ribasushi)
523 ? delete $changes{$position_column} # means there was a position change supplied with the update too
524 : $self->_position # FIXME!
525 ),
526 );
527 }
528 elsif (exists $changes{$position_column}) {
529 $self->move_to(delete $changes{$position_column});
fa6b598f 530 }
531
8f535707 532 my @res;
533 my $want = wantarray();
534 if (not defined $want) {
535 $self->next::method( \%changes, @_ );
536 }
537 elsif ($want) {
538 @res = $self->next::method( \%changes, @_ );
539 }
540 else {
541 $res[0] = $self->next::method( \%changes, @_ );
542 }
543
544 $guard->commit;
545 return $want ? @res : $res[0];
79dc353a 546 }
79dc353a 547}
548
118e6b96 549=head2 delete
550
551Overrides the DBIC delete() method by first moving the object
bd7ca9e8 552to the last position, then deleting it, thus ensuring the
118e6b96 553integrity of the positions.
554
555=cut
556
557sub delete {
558 my $self = shift;
8f535707 559
560 my $guard = $self->result_source->schema->txn_scope_guard;
561
562 $self->move_last;
563
564 my @res;
565 my $want = wantarray();
566 if (not defined $want) {
567 $self->next::method( @_ );
bd7ca9e8 568 }
8f535707 569 elsif ($want) {
570 @res = $self->next::method( @_ );
571 }
572 else {
573 $res[0] = $self->next::method( @_ );
574 }
575
576 $guard->commit;
577 return $want ? @res : $res[0];
bd7ca9e8 578}
579
b250066f 580=head1 METHODS FOR EXTENDING ORDERED
bd7ca9e8 581
582You would want to override the methods below if you use sparse
583(non-linear) or non-numeric position values. This can be useful
584if you are working with preexisting non-normalised position data,
585or if you need to work with materialized path columns.
586
587=head2 _position
588
589 my $num_pos = $item->_position;
590
b250066f 591Returns the B<absolute numeric position> of the current object, with the
bd7ca9e8 592first object being at position 1, its sibling at position 2 and so on.
593By default simply returns the value of L</position_column>.
594
595=cut
596sub _position {
597 my $self = shift;
598
599# #the right way to do this
600# return $self->previous_siblings->count + 1;
601
602 return $self->get_column ($self->position_column);
603}
604
605=head2 _position_value
606
607 my $pos_value = $item->_position_value ( $pos )
608
b250066f 609Returns the B<value> of L</position_column> of the object at numeric
bd7ca9e8 610position C<$pos>. By default simply returns C<$pos>.
611
612=cut
613sub _position_value {
614 my ($self, $pos) = @_;
615
616# #the right way to do this (not optimized)
617# my $position_column = $self->position_column;
618# return $self -> _group_rs
619# -> search({}, { order_by => $position_column })
620# -> slice ( $pos - 1)
621# -> single
622# -> get_column ($position_column);
623
624 return $pos;
625}
626
627=head2 _initial_position_value
628
629 __PACKAGE__->_initial_position_value(0);
630
b250066f 631This method specifies a B<value> of L</position_column> which is assigned
bd7ca9e8 632to the first inserted element of a group, if no value was supplied at
633insertion time. All subsequent values are derived from this one by
634L</_next_position_value> below. Defaults to 1.
635
636=cut
637
638__PACKAGE__->mk_classdata( '_initial_position_value' => 1 );
639
640=head2 _next_position_value
641
642 my $new_value = $item->_next_position_value ( $position_value )
643
b250066f 644Returns a position B<value> that would be considered C<next> with
bd7ca9e8 645regards to C<$position_value>. Can be pretty much anything, given
646that C<< $position_value < $new_value >> where C<< < >> is the
647SQL comparison operator (usually works fine on strings). The
648default method expects C<$position_value> to be numeric, and
649returns C<$position_value + 1>
650
651=cut
652sub _next_position_value {
653 return $_[1] + 1;
654}
655
656=head2 _shift_siblings
657
658 $item->_shift_siblings ($direction, @between)
659
b250066f 660Shifts all siblings with B<positions values> in the range @between
661(inclusive) by one position as specified by $direction (left if < 0,
662 right if > 0). By default simply increments/decrements each
663L<position_column> value by 1, doing so in a way as to not violate
664any existing constraints.
665
666Note that if you override this method and have unique constraints
667including the L<position_column> the shift is not a trivial task.
668Refer to the implementation source of the default method for more
669information.
bd7ca9e8 670
671=cut
672sub _shift_siblings {
673 my ($self, $direction, @between) = @_;
674 return 0 unless $direction;
675
676 my $position_column = $self->position_column;
677
678 my ($op, $ord);
679 if ($direction < 0) {
680 $op = '-';
681 $ord = 'asc';
682 }
683 else {
684 $op = '+';
685 $ord = 'desc';
686 }
687
688 my $shift_rs = $self->_group_rs-> search ({ $position_column => { -between => \@between } });
689
690 # some databases (sqlite) are dumb and can not do a blanket
691 # increment/decrement. So what we do here is check if the
692 # position column is part of a unique constraint, and do a
693 # one-by-one update if this is the case
694
b250066f 695 if (grep { $_ eq $position_column } ( map { @$_ } (values %{{ $self->result_source->unique_constraints }} ) ) ) {
bd7ca9e8 696
697 my $rs = $shift_rs->search ({}, { order_by => { "-$ord", $position_column } } );
698 # FIXME - no need to inflate each row
699 while (my $r = $rs->next) {
700 $r->_ordered_internal_update ({ $position_column => \ "$position_column $op 1" } );
701 }
702 }
703 else {
704 $shift_rs->update ({ $position_column => \ "$position_column $op 1" } );
705 }
118e6b96 706}
707
7a76f44c 708=head1 PRIVATE METHODS
709
710These methods are used internally. You should never have the
711need to use them.
712
bd7ca9e8 713=head2 _group_rs
714
b250066f 715This method returns a resultset containing all members of the row
bd7ca9e8 716group (including the row itself).
717
718=cut
719sub _group_rs {
720 my $self = shift;
721 return $self->result_source->resultset->search({$self->_grouping_clause()});
722}
723
724=head2 _siblings
725
726Returns an unordered resultset of all objects in the same group
727excluding the object you called this method on.
728
729=cut
730sub _siblings {
731 my $self = shift;
732 my $position_column = $self->position_column;
733 return $self->_group_rs->search(
734 { $position_column => { '!=' => $self->get_column($position_column) } },
735 );
736}
737
a733c37f 738=head2 _grouping_clause
118e6b96 739
bd7ca9e8 740This method returns one or more name=>value pairs for limiting a search
741by the grouping column(s). If the grouping column is not
133dd22a 742defined then this will return an empty list.
118e6b96 743
7a76f44c 744=cut
a733c37f 745sub _grouping_clause {
169bb185 746 my( $self ) = @_;
fa6b598f 747 return map { $_ => $self->get_column($_) } $self->_grouping_columns();
748}
749
fa6b598f 750=head2 _get_grouping_columns
751
752Returns a list of the column names used for grouping, regardless of whether
1d941d67 753they were specified as an arrayref or a single string, and returns ()
754if there is no grouping.
fa6b598f 755
756=cut
757sub _grouping_columns {
758 my( $self ) = @_;
a733c37f 759 my $col = $self->grouping_column();
fa6b598f 760 if (ref $col eq 'ARRAY') {
761 return @$col;
762 } elsif ($col) {
763 return ( $col );
764 } else {
765 return ();
133dd22a 766 }
7a76f44c 767}
768
bd7ca9e8 769=head2 _is_in_group
fa6b598f 770
771 $item->_is_in_group( {user => 'fred', list => 'work'} )
772
773Returns true if the object is in the group represented by hashref $other
bd7ca9e8 774
fa6b598f 775=cut
776sub _is_in_group {
777 my ($self, $other) = @_;
778 my $current = {$self->_grouping_clause};
bd7ca9e8 779
780 no warnings qw/uninitialized/;
781
782 return 0 if (
783 join ("\x00", sort keys %$current)
784 ne
785 join ("\x00", sort keys %$other)
786 );
fa6b598f 787 for my $key (keys %$current) {
fa6b598f 788 return 0 if $current->{$key} ne $other->{$key};
789 }
790 return 1;
791}
792
b250066f 793=head2 _ordered_internal_update
794
795This is a short-circuited method, that is used internally by this
796module to update positioning values in isolation (i.e. without
797triggering any of the positioning integrity code).
798
f045efad 799Some day you might get confronted by datasets that have ambiguous
800positioning data (i.e. duplicate position values within the same group,
b250066f 801in a table without unique constraints). When manually fixing such data
802keep in mind that you can not invoke L<DBIx::Class::Row/update> like
f045efad 803you normally would, as it will get confused by the wrong data before
b250066f 804having a chance to update the ill-defined row. If you really know what
f045efad 805you are doing use this method which bypasses any hooks introduced by
b250066f 806this module.
807
808=cut
809
bd7ca9e8 810sub _ordered_internal_update {
811 my $self = shift;
812 local $self->{_ORDERED_INTERNAL_UPDATE} = 1;
813 return $self->update (@_);
814}
fa6b598f 815
7a76f44c 8161;
118e6b96 817
bd7ca9e8 818__END__
dc66dea1 819
bd7ca9e8 820=head1 CAVEATS
dc66dea1 821
133dd22a 822=head2 Race Condition on Insert
823
118e6b96 824If a position is not specified for an insert than a position
bd7ca9e8 825will be chosen based either on L</_initial_position_value> or
826L</_next_position_value>, depending if there are already some
827items in the current group. The space of time between the
828necessary selects and insert introduces a race condition.
829Having unique constraints on your position/group columns,
830and using transactions (see L<DBIx::Class::Storage/txn_do>)
831will prevent such race conditions going undetected.
118e6b96 832
133dd22a 833=head2 Multiple Moves
834
835Be careful when issueing move_* methods to multiple objects. If
836you've pre-loaded the objects then when you move one of the objects
837the position of the other object will not reflect their new value
bd7ca9e8 838until you reload them from the database - see
839L<DBIx::Class::Row/discard_changes>.
133dd22a 840
dc66dea1 841There are times when you will want to move objects as groups, such
133dd22a 842as changeing the parent of several objects at once - this directly
843conflicts with this problem. One solution is for us to write a
844ResultSet class that supports a parent() method, for example. Another
845solution is to somehow automagically modify the objects that exist
846in the current object's result set to have the new position value.
847
58755bba 848=head2 Default Values
849
850Using a database defined default_value on one of your group columns
851could result in the position not being assigned correctly.
852
118e6b96 853=head1 AUTHOR
854
8f535707 855 Original code framework
856 Aran Deltac <bluefeet@cpan.org>
857
858 Constraints support and code generalisation
859 Peter Rabbitson <ribasushi@cpan.org>
118e6b96 860
861=head1 LICENSE
862
863You may distribute this code under the same terms as Perl itself.
864