1 package DBIx::Class::Ordered;
4 use base qw( DBIx::Class );
8 DBIx::Class::Ordered - Modify the position of objects in an ordered list.
12 Create a table for your ordered data.
15 item_id INTEGER PRIMARY KEY AUTOINCREMENT,
17 position INTEGER NOT NULL
20 Optionally, add one or more columns to specify groupings, allowing you
21 to maintain independent ordered lists within one table:
24 item_id INTEGER PRIMARY KEY AUTOINCREMENT,
26 position INTEGER NOT NULL,
27 group_id INTEGER NOT NULL
33 item_id INTEGER PRIMARY KEY AUTOINCREMENT,
35 position INTEGER NOT NULL,
36 group_id INTEGER NOT NULL,
37 other_group_id INTEGER NOT NULL
40 In your Schema or DB class add "Ordered" to the top
41 of the component list.
43 __PACKAGE__->load_components(qw( Ordered ... ));
45 Specify the column that stores the position number for
49 __PACKAGE__->position_column('position');
51 If you are using one grouping column, specify it as follows:
53 __PACKAGE__->grouping_column('group_id');
55 Or if you have multiple grouping columns:
57 __PACKAGE__->grouping_column(['group_id', 'other_group_id']);
59 That's it, now you can change the position of your objects.
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 });
68 my $rs = $item->siblings();
69 my @siblings = $item->siblings();
72 $sibling = $item->first_sibling();
73 $sibling = $item->last_sibling();
74 $sibling = $item->previous_sibling();
75 $sibling = $item->next_sibling();
77 $item->move_previous();
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 );
89 This module provides a simple interface for modifying the ordered
90 position of DBIx::Class objects.
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.
100 =head2 position_column
102 __PACKAGE__->position_column('position');
104 Sets and retrieves the name of the column that stores the
105 positional value of each record. Defaults to "position".
109 __PACKAGE__->mk_classdata( 'position_column' => 'position' );
111 =head2 grouping_column
113 __PACKAGE__->grouping_column('group_id');
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.
121 __PACKAGE__->mk_classdata( 'grouping_column' );
123 =head2 null_position_value
125 __PACKAGE__->null_position_value(undef);
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
136 __PACKAGE__->mk_classdata( 'null_position_value' => 0 );
140 my $rs = $item->siblings();
141 my @siblings = $item->siblings();
143 Returns an B<ordered> resultset of all other objects in the same
144 group excluding the one you called it on.
146 The ordering is a backwards-compatibility artifact - if you need
147 a resultset with no ordering applied use C<_siblings>
152 return $self->_siblings->search ({}, { order_by => $self->position_column } );
155 =head2 previous_siblings
157 my $prev_rs = $item->previous_siblings();
158 my @prev_siblings = $item->previous_siblings();
160 Returns a resultset of all objects in the same group
161 positioned before the object on which this method was called.
164 sub previous_siblings {
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 } })
176 my $next_rs = $item->next_siblings();
177 my @next_siblings = $item->next_siblings();
179 Returns a resultset of all objects in the same group
180 positioned after the object on which this method was called.
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 } })
193 =head2 previous_sibling
195 my $sibling = $item->previous_sibling();
197 Returns the sibling that resides one position back. Returns 0
198 if the current object is the first one.
202 sub previous_sibling {
204 my $position_column = $self->position_column;
206 my $psib = $self->previous_siblings->search(
208 { rows => 1, order_by => { '-desc' => $position_column } },
211 return defined $psib ? $psib : 0;
216 my $sibling = $item->first_sibling();
218 Returns the first sibling object, or 0 if the first sibling
225 my $position_column = $self->position_column;
227 my $fsib = $self->previous_siblings->search(
229 { rows => 1, order_by => { '-asc' => $position_column } },
232 return defined $fsib ? $fsib : 0;
237 my $sibling = $item->next_sibling();
239 Returns the sibling that resides one position forward. Returns 0
240 if the current object is the last one.
246 my $position_column = $self->position_column;
247 my $nsib = $self->next_siblings->search(
249 { rows => 1, order_by => { '-asc' => $position_column } },
252 return defined $nsib ? $nsib : 0;
257 my $sibling = $item->last_sibling();
259 Returns the last sibling, or 0 if the last sibling is this
266 my $position_column = $self->position_column;
267 my $lsib = $self->next_siblings->search(
269 { rows => 1, order_by => { '-desc' => $position_column } },
272 return defined $lsib ? $lsib : 0;
275 # an optimized method to get the last sibling position value without inflating a result object
276 sub _last_sibling_posval {
278 my $position_column = $self->position_column;
280 my $cursor = $self->next_siblings->search(
282 { rows => 1, order_by => { '-desc' => $position_column }, select => $position_column },
285 my ($pos) = $cursor->next;
291 $item->move_previous();
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.
301 return $self->move_to ($self->_position - 1);
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.
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);
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.
330 return shift->move_to( 1 );
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.
344 my $last_posval = $self->_last_sibling_posval;
346 return 0 unless defined $last_posval;
348 return $self->move_to( $self->_position_from_value ($last_posval) );
353 $item->move_to( $position );
355 Moves the object to the specified position. Returns 1 on
356 success, and 0 if the object is already at the specified
362 my( $self, $to_position ) = @_;
363 return 0 if ( $to_position < 1 );
365 my $position_column = $self->position_column;
368 if ($is_txn = $self->result_source->schema->storage->transaction_depth) {
369 # Reload position state from storage
370 # The thinking here is that if we are in a transaction, it is
371 # *more likely* the object went out of sync due to resultset
372 # level shenanigans. Instead of always reloading (slow) - go
373 # ahead and hand-hold only in the case of higher layers
374 # requesting the safety of a txn
378 ( $self->result_source
380 ->search($self->_storage_ident_condition, { rows => 1, columns => $position_column })
383 )[0] || $self->throw_exception(
384 sprintf "Unable to locate object '%s' in storage - object went ouf of sync...?",
388 delete $self->{_dirty_columns}{$position_column};
390 elsif ($self->is_column_changed ($position_column) ) {
391 # something changed our position, we need to know where we
392 # used to be - use the stashed value
393 $self->store_column($position_column, delete $self->{_column_data_in_storage}{$position_column});
394 delete $self->{_dirty_columns}{$position_column};
397 my $from_position = $self->_position;
399 if ( $from_position == $to_position ) { # FIXME this will not work for non-numeric order
403 my $guard = $is_txn ? undef : $self->result_source->schema->txn_scope_guard;
405 my ($direction, @between);
406 if ( $from_position < $to_position ) {
408 @between = map { $self->_position_value ($_) } ( $from_position + 1, $to_position );
412 @between = map { $self->_position_value ($_) } ( $to_position, $from_position - 1 );
415 my $new_pos_val = $self->_position_value ($to_position); # record this before the shift
417 # we need to null-position the moved row if the position column is part of a constraint
418 if (grep { $_ eq $position_column } ( map { @$_ } (values %{{ $self->result_source->unique_constraints }} ) ) ) {
419 $self->_ordered_internal_update({ $position_column => $self->null_position_value });
422 $self->_shift_siblings ($direction, @between);
423 $self->_ordered_internal_update({ $position_column => $new_pos_val });
425 $guard->commit if $guard;
431 $item->move_to_group( $group, $position );
433 Moves the object to the specified position of the specified
434 group, or to the end of the group if $position is undef.
435 1 is returned on success, and 0 is returned if the object is
436 already at the specified position of the specified group.
438 $group may be specified as a single scalar if only one
439 grouping column is in use, or as a hashref of column => value pairs
440 if multiple grouping columns are in use.
445 my( $self, $to_group, $to_position ) = @_;
447 # if we're given a single value, turn it into a hashref
448 unless (ref $to_group eq 'HASH') {
449 my @gcols = $self->_grouping_columns;
451 $self->throw_exception ('Single group supplied for a multi-column group identifier') if @gcols > 1;
452 $to_group = {$gcols[0] => $to_group};
455 my $position_column = $self->position_column;
457 return 0 if ( defined($to_position) and $to_position < 1 );
459 # check if someone changed the _grouping_columns - this will
460 # prevent _is_in_group working, so we need to restore the
461 # original stashed values
462 for ($self->_grouping_columns) {
463 if ($self->is_column_changed ($_)) {
464 $self->store_column($_, delete $self->{_column_data_in_storage}{$_});
465 delete $self->{_dirty_columns}{$_};
469 if ($self->_is_in_group ($to_group) ) {
471 if (defined $to_position) {
472 $ret = $self->move_to ($to_position);
478 my $guard = $self->result_source->schema->txn_scope_guard;
480 # Move to end of current group to adjust siblings
483 $self->set_inflated_columns({ %$to_group, $position_column => undef });
484 my $new_group_last_posval = $self->_last_sibling_posval;
485 my $new_group_last_position = $self->_position_from_value (
486 $new_group_last_posval
489 if ( not defined($to_position) or $to_position > $new_group_last_position) {
491 $position_column => $new_group_last_position
492 ? $self->_next_position_value ( $new_group_last_posval )
493 : $self->_initial_position_value
497 my $bumped_pos_val = $self->_position_value ($to_position);
498 my @between = map { $self->_position_value ($_) } ($to_position, $new_group_last_position);
499 $self->_shift_siblings (1, @between); #shift right
500 $self->set_column( $position_column => $bumped_pos_val );
503 $self->_ordered_internal_update;
512 Overrides the DBIC insert() method by providing a default
513 position number. The default will be the number of rows in
514 the table +1, thus positioning the new record at the last position.
520 my $position_column = $self->position_column;
522 unless ($self->get_column($position_column)) {
523 my $lsib_posval = $self->_last_sibling_posval;
525 $position_column => (defined $lsib_posval
526 ? $self->_next_position_value ( $lsib_posval )
527 : $self->_initial_position_value
532 return $self->next::method( @_ );
537 Overrides the DBIC update() method by checking for a change
538 to the position and/or group columns. Movement within a
539 group or to another group is handled by repositioning
540 the appropriate siblings. Position defaults to the end
541 of a new group if it has been changed to undef.
548 # this is set by _ordered_internal_update()
549 return $self->next::method(@_) if $self->result_source->schema->{_ORDERED_INTERNAL_UPDATE};
552 $self->set_inflated_columns($upd) if $upd;
554 my $position_column = $self->position_column;
555 my @group_columns = $self->_grouping_columns;
557 # see if the order is already changed
558 my $changed_ordering_cols = { map { $_ => $self->get_column($_) } grep { $self->is_column_changed($_) } ($position_column, @group_columns) };
560 # nothing changed - short circuit
561 if (! keys %$changed_ordering_cols) {
562 return $self->next::method( undef, @_ );
564 elsif (grep { exists $changed_ordering_cols->{$_} } @group_columns ) {
565 $self->move_to_group(
566 # since the columns are already re-set the _grouping_clause is correct
567 # move_to_group() knows how to get the original storage values
568 { $self->_grouping_clause },
570 # The FIXME bit contradicts the documentation: POD states that
571 # when changing groups without supplying explicit positions in
572 # move_to_group(), we push the item to the end of the group.
573 # However when I was rewriting this, the position from the old
574 # group was clearly passed to the new one
575 # Probably needs to go away (by ribasushi)
576 (exists $changed_ordering_cols->{$position_column}
577 ? $changed_ordering_cols->{$position_column} # means there was a position change supplied with the update too
578 : $self->_position # FIXME! (replace with undef)
583 $self->move_to($changed_ordering_cols->{$position_column});
591 Overrides the DBIC delete() method by first moving the object
592 to the last position, then deleting it, thus ensuring the
593 integrity of the positions.
600 my $guard = $self->result_source->schema->txn_scope_guard;
604 $self->next::method( @_ );
611 # add the current position/group to the things we track old values for
612 sub _track_storage_value {
613 my ($self, $col) = @_;
615 $self->next::method($col)
617 grep { $_ eq $col } ($self->position_column, $self->_grouping_columns)
621 =head1 METHODS FOR EXTENDING ORDERED
623 You would want to override the methods below if you use sparse
624 (non-linear) or non-numeric position values. This can be useful
625 if you are working with preexisting non-normalised position data,
626 or if you need to work with materialized path columns.
628 =head2 _position_from_value
630 my $num_pos = $item->_position_from_value ( $pos_value )
632 Returns the B<absolute numeric position> of an object with a B<position
633 value> set to C<$pos_value>. By default simply returns C<$pos_value>.
636 sub _position_from_value {
637 my ($self, $val) = @_;
639 return 0 unless defined $val;
641 # #the right way to do this
642 # return $self -> _group_rs
643 # -> search({ $self->position_column => { '<=', $val } })
649 =head2 _position_value
651 my $pos_value = $item->_position_value ( $pos )
653 Returns the B<value> of L</position_column> of the object at numeric
654 position C<$pos>. By default simply returns C<$pos>.
657 sub _position_value {
658 my ($self, $pos) = @_;
660 # #the right way to do this (not optimized)
661 # my $position_column = $self->position_column;
662 # return $self -> _group_rs
663 # -> search({}, { order_by => $position_column })
664 # -> slice ( $pos - 1)
666 # -> get_column ($position_column);
671 =head2 _initial_position_value
673 __PACKAGE__->_initial_position_value(0);
675 This method specifies a B<value> of L</position_column> which is assigned
676 to the first inserted element of a group, if no value was supplied at
677 insertion time. All subsequent values are derived from this one by
678 L</_next_position_value> below. Defaults to 1.
682 __PACKAGE__->mk_classdata( '_initial_position_value' => 1 );
684 =head2 _next_position_value
686 my $new_value = $item->_next_position_value ( $position_value )
688 Returns a position B<value> that would be considered C<next> with
689 regards to C<$position_value>. Can be pretty much anything, given
690 that C<< $position_value < $new_value >> where C<< < >> is the
691 SQL comparison operator (usually works fine on strings). The
692 default method expects C<$position_value> to be numeric, and
693 returns C<$position_value + 1>
696 sub _next_position_value {
700 =head2 _shift_siblings
702 $item->_shift_siblings ($direction, @between)
704 Shifts all siblings with B<positions values> in the range @between
705 (inclusive) by one position as specified by $direction (left if < 0,
706 right if > 0). By default simply increments/decrements each
707 L</position_column> value by 1, doing so in a way as to not violate
708 any existing constraints.
710 Note that if you override this method and have unique constraints
711 including the L</position_column> the shift is not a trivial task.
712 Refer to the implementation source of the default method for more
716 sub _shift_siblings {
717 my ($self, $direction, @between) = @_;
718 return 0 unless $direction;
720 my $position_column = $self->position_column;
723 if ($direction < 0) {
732 my $shift_rs = $self->_group_rs-> search ({ $position_column => { -between => \@between } });
734 # some databases (sqlite, pg, perhaps others) are dumb and can not do a
735 # blanket increment/decrement without violating a unique constraint.
736 # So what we do here is check if the position column is part of a unique
737 # constraint, and do a one-by-one update if this is the case.
738 my $rsrc = $self->result_source;
740 # set in case there are more cascades combined with $rs->update => $rs_update_all overrides
741 local $rsrc->schema->{_ORDERED_INTERNAL_UPDATE} = 1;
742 my @pcols = $rsrc->primary_columns;
744 grep { $_ eq $position_column } ( map { @$_ } (values %{{ $rsrc->unique_constraints }} ) )
746 my $clean_rs = $rsrc->resultset;
748 for ( $shift_rs->search (
749 {}, { order_by => { "-$ord", $position_column }, select => [$position_column, @pcols] }
752 $clean_rs->find(@$_)->update ({ $position_column => $pos + ( ($op eq '+') ? 1 : -1 ) });
756 $shift_rs->update ({ $position_column => \ "$position_column $op 1" } );
761 # This method returns a resultset containing all members of the row
762 # group (including the row itself).
765 return $self->result_source->resultset->search({$self->_grouping_clause()});
768 # Returns an unordered resultset of all objects in the same group
769 # excluding the object you called this method on.
772 my $position_column = $self->position_column;
774 return defined ($pos = $self->get_column($position_column))
775 ? $self->_group_rs->search(
776 { $position_column => { '!=' => $pos } },
782 # Returns the B<absolute numeric position> of the current object, with the
783 # first object being at position 1, its sibling at position 2 and so on.
786 return $self->_position_from_value ($self->get_column ($self->position_column) );
789 # This method returns one or more name=>value pairs for limiting a search
790 # by the grouping column(s). If the grouping column is not defined then
791 # this will return an empty list.
792 sub _grouping_clause {
794 return map { $_ => $self->get_column($_) } $self->_grouping_columns();
797 # Returns a list of the column names used for grouping, regardless of whether
798 # they were specified as an arrayref or a single string, and returns ()
799 # if there is no grouping.
800 sub _grouping_columns {
802 my $col = $self->grouping_column();
803 if (ref $col eq 'ARRAY') {
812 # Returns true if the object is in the group represented by hashref $other
814 my ($self, $other) = @_;
815 my $current = {$self->_grouping_clause};
817 no warnings qw/uninitialized/;
820 join ("\x00", sort keys %$current)
822 join ("\x00", sort keys %$other)
824 for my $key (keys %$current) {
825 return 0 if $current->{$key} ne $other->{$key};
830 # This is a short-circuited method, that is used internally by this
831 # module to update positioning values in isolation (i.e. without
832 # triggering any of the positioning integrity code).
834 # Some day you might get confronted by datasets that have ambiguous
835 # positioning data (e.g. duplicate position values within the same group,
836 # in a table without unique constraints). When manually fixing such data
837 # keep in mind that you can not invoke L<DBIx::Class::Row/update> like
838 # you normally would, as it will get confused by the wrong data before
839 # having a chance to update the ill-defined row. If you really know what
840 # you are doing use this method which bypasses any hooks introduced by
842 sub _ordered_internal_update {
844 local $self->result_source->schema->{_ORDERED_INTERNAL_UPDATE} = 1;
845 return $self->update (@_);
854 =head2 Resultset Methods
856 Note that all Insert/Create/Delete overrides are happening on
857 L<DBIx::Class::Row> methods only. If you use the
858 L<DBIx::Class::ResultSet> versions of
859 L<update|DBIx::Class::ResultSet/update> or
860 L<delete|DBIx::Class::ResultSet/delete>, all logic present in this
861 module will be bypassed entirely (possibly resulting in a broken
862 order-tree). Instead always use the
863 L<update_all|DBIx::Class::ResultSet/update_all> and
864 L<delete_all|DBIx::Class::ResultSet/delete_all> methods, which will
865 invoke the corresponding L<row|DBIx::Class::Row> method on every
866 member of the given resultset.
868 =head2 Race Condition on Insert
870 If a position is not specified for an insert, a position
871 will be chosen based either on L</_initial_position_value> or
872 L</_next_position_value>, depending if there are already some
873 items in the current group. The space of time between the
874 necessary selects and insert introduces a race condition.
875 Having unique constraints on your position/group columns,
876 and using transactions (see L<DBIx::Class::Storage/txn_do>)
877 will prevent such race conditions going undetected.
879 =head2 Multiple Moves
881 If you have multiple same-group result objects already loaded from storage,
882 you need to be careful when executing C<move_*> operations on them:
883 without a L</position_column> reload the L</_position_value> of the
884 "siblings" will be out of sync with the underlying storage.
886 Starting from version C<0.082800> DBIC will implicitly perform such
887 reloads when the C<move_*> happens as a part of a transaction
888 (a good example of such situation is C<< $ordered_resultset->delete_all >>).
890 If it is not possible for you to wrap the entire call-chain in a transaction,
891 you will need to call L<DBIx::Class::Row/discard_changes> to get an object
892 up-to-date before proceeding, otherwise undefined behavior will result.
894 =head2 Default Values
896 Using a database defined default_value on one of your group columns
897 could result in the position not being assigned correctly.
899 =head1 FURTHER QUESTIONS?
901 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
903 =head1 COPYRIGHT AND LICENSE
905 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
906 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
907 redistribute it and/or modify it under the same terms as the
908 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.