X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FOrdered.pm;h=2ac0a0781ca353528fb361e867e2ec90c965c9b2;hb=7474ed3b192693baa28d2f52de502f0ec3e8ac4e;hp=7842a4059d7913e8be0c9bff3f0b5e571ec03ece;hpb=48580715af3072905f2c71dc27e7f70f21a11338;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Ordered.pm b/lib/DBIx/Class/Ordered.pm index 7842a40..2ac0a07 100644 --- a/lib/DBIx/Class/Ordered.pm +++ b/lib/DBIx/Class/Ordered.pm @@ -3,6 +3,9 @@ use strict; use warnings; use base qw( DBIx::Class ); +use DBIx::Class::_Util qw( bag_eq fail_on_internal_call ); +use namespace::clean; + =head1 NAME DBIx::Class::Ordered - Modify the position of objects in an ordered list. @@ -17,7 +20,7 @@ Create a table for your ordered data. position INTEGER NOT NULL ); -Optionally, add one or more columns to specify groupings, allowing you +Optionally, add one or more columns to specify groupings, allowing you to maintain independent ordered lists within one table: CREATE TABLE items ( @@ -37,12 +40,12 @@ Or even other_group_id INTEGER NOT NULL ); -In your Schema or DB class add "Ordered" to the top +In your Schema or DB class add "Ordered" to the top of the component list. __PACKAGE__->load_components(qw( Ordered ... )); -Specify the column that stores the position number for +Specify the column that stores the position number for each row. package My::Item; @@ -86,13 +89,13 @@ That's it, now you can change the position of your objects. =head1 DESCRIPTION -This module provides a simple interface for modifying the ordered +This module provides a simple interface for modifying the ordered position of DBIx::Class objects. =head1 AUTO UPDATE -All of the move_* methods automatically update the rows involved in -the query. This is not configurable and is due to the fact that if you +All of the move_* methods automatically update the rows involved in +the query. This is not configurable and is due to the fact that if you move a record it always causes other records in the list to be updated. =head1 METHODS @@ -101,24 +104,24 @@ move a record it always causes other records in the list to be updated. __PACKAGE__->position_column('position'); -Sets and retrieves the name of the column that stores the +Sets and retrieves the name of the column that stores the positional value of each record. Defaults to "position". =cut -__PACKAGE__->mk_classdata( 'position_column' => 'position' ); +__PACKAGE__->mk_classaccessor( 'position_column' => 'position' ); =head2 grouping_column __PACKAGE__->grouping_column('group_id'); -This method specifies a column to limit all queries in -this module by. This effectively allows you to have multiple +This method specifies a column to limit all queries in +this module by. This effectively allows you to have multiple ordered lists within the same table. =cut -__PACKAGE__->mk_classdata( 'grouping_column' ); +__PACKAGE__->mk_group_accessors( inherited => 'grouping_column' ); =head2 null_position_value @@ -133,7 +136,7 @@ indeed start from 0. =cut -__PACKAGE__->mk_classdata( 'null_position_value' => 0 ); +__PACKAGE__->mk_classaccessor( 'null_position_value' => 0 ); =head2 siblings @@ -143,13 +146,28 @@ __PACKAGE__->mk_classdata( 'null_position_value' => 0 ); Returns an B resultset of all other objects in the same group excluding the one you called it on. +Underneath calls L, and therefore returns +objects by implicitly invoking Lall() >>|DBIx::Class::ResultSet/all> +in list context. + The ordering is a backwards-compatibility artifact - if you need -a resultset with no ordering applied use L +a resultset with no ordering applied use C<_siblings> =cut + sub siblings { - my $self = shift; - return $self->_siblings->search ({}, { order_by => $self->position_column } ); + #my $self = shift; + + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS + and + wantarray + and + ! eval { fail_on_internal_call; 1 } + and + die "ILLEGAL LIST CONTEXT INVOCATION: $@"; + + # *MUST* be context sensitive due to legacy (DO NOT call search_rs) + $_[0]->_siblings->search ({}, { order_by => $_[0]->position_column } ); } =head2 previous_siblings @@ -160,15 +178,29 @@ sub siblings { Returns a resultset of all objects in the same group positioned before the object on which this method was called. +Underneath calls L, and therefore returns +objects by implicitly invoking Lall() >>|DBIx::Class::ResultSet/all> +in list context. + =cut sub previous_siblings { my $self = shift; my $position_column = $self->position_column; my $position = $self->get_column ($position_column); - return ( defined $position + + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS + and + wantarray + and + ! eval { fail_on_internal_call; 1 } + and + die "ILLEGAL LIST CONTEXT INVOCATION: $@"; + + # *MUST* be context sensitive due to legacy (DO NOT call search_rs) + defined( $position ) ? $self->_siblings->search ({ $position_column => { '<', $position } }) : $self->_siblings - ); + ; } =head2 next_siblings @@ -179,15 +211,29 @@ sub previous_siblings { Returns a resultset of all objects in the same group positioned after the object on which this method was called. +Underneath calls L, and therefore returns +objects by implicitly invoking Lall() >>|DBIx::Class::ResultSet/all> +in list context. + =cut sub next_siblings { my $self = shift; my $position_column = $self->position_column; my $position = $self->get_column ($position_column); - return ( defined $position + + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS + and + wantarray + and + ! eval { fail_on_internal_call; 1 } + and + die "ILLEGAL LIST CONTEXT INVOCATION: $@"; + + # *MUST* be context sensitive due to legacy (DO NOT call search_rs) + defined( $position ) ? $self->_siblings->search ({ $position_column => { '>', $position } }) : $self->_siblings - ); + ; } =head2 previous_sibling @@ -208,14 +254,14 @@ sub previous_sibling { { rows => 1, order_by => { '-desc' => $position_column } }, )->single; - return defined $psib ? $psib : 0; + return defined( $psib ) ? $psib : 0; } =head2 first_sibling my $sibling = $item->first_sibling(); -Returns the first sibling object, or 0 if the first sibling +Returns the first sibling object, or 0 if the first sibling is this sibling. =cut @@ -229,7 +275,7 @@ sub first_sibling { { rows => 1, order_by => { '-asc' => $position_column } }, )->single; - return defined $fsib ? $fsib : 0; + return defined( $fsib ) ? $fsib : 0; } =head2 next_sibling @@ -249,14 +295,14 @@ sub next_sibling { { rows => 1, order_by => { '-asc' => $position_column } }, )->single; - return defined $nsib ? $nsib : 0; + return defined( $nsib ) ? $nsib : 0; } =head2 last_sibling my $sibling = $item->last_sibling(); -Returns the last sibling, or 0 if the last sibling is this +Returns the last sibling, or 0 if the last sibling is this sibling. =cut @@ -269,10 +315,10 @@ sub last_sibling { { rows => 1, order_by => { '-desc' => $position_column } }, )->single; - return defined $lsib ? $lsib : 0; + return defined( $lsib ) ? $lsib : 0; } -# an optimized method to get the last sibling position value without inflating a row object +# an optimized method to get the last sibling position value without inflating a result object sub _last_sibling_posval { my $self = shift; my $position_column = $self->position_column; @@ -282,8 +328,7 @@ sub _last_sibling_posval { { rows => 1, order_by => { '-desc' => $position_column }, select => $position_column }, )->cursor; - my ($pos) = $cursor->next; - return $pos; + ($cursor->next)[0]; } =head2 move_previous @@ -364,33 +409,44 @@ sub move_to { my $position_column = $self->position_column; - my $guard; - - if ($self->is_column_changed ($position_column) ) { - # something changed our position, we have no idea where we - # used to be - requery without using discard_changes - # (we need only a specific column back) - - $guard = $self->result_source->schema->txn_scope_guard; - - my $cursor = $self->result_source->resultset->search( - $self->ident_condition, - { select => $position_column }, - )->cursor; + my $rsrc = $self->result_source; - my ($pos) = $cursor->next; - $self->$position_column ($pos); + my $is_txn; + if ($is_txn = $rsrc->schema->storage->transaction_depth) { + # Reload position state from storage + # The thinking here is that if we are in a transaction, it is + # *more likely* the object went out of sync due to resultset + # level shenanigans. Instead of always reloading (slow) - go + # ahead and hand-hold only in the case of higher layers + # requesting the safety of a txn + + $self->store_column( + $position_column, + ( $rsrc->resultset + ->search($self->_storage_ident_condition, { rows => 1, columns => $position_column }) + ->cursor + ->next + )[0] || $self->throw_exception( + sprintf "Unable to locate object '%s' in storage - object went ouf of sync...?", + $self->ID + ), + ); + delete $self->{_dirty_columns}{$position_column}; + } + elsif ($self->is_column_changed ($position_column) ) { + # something changed our position, we need to know where we + # used to be - use the stashed value + $self->store_column($position_column, delete $self->{_column_data_in_storage}{$position_column}); delete $self->{_dirty_columns}{$position_column}; } my $from_position = $self->_position; if ( $from_position == $to_position ) { # FIXME this will not work for non-numeric order - $guard->commit if $guard; return 0; } - $guard ||= $self->result_source->schema->txn_scope_guard; + my $guard = $is_txn ? undef : $rsrc->schema->txn_scope_guard; my ($direction, @between); if ( $from_position < $to_position ) { @@ -405,14 +461,14 @@ sub move_to { my $new_pos_val = $self->_position_value ($to_position); # record this before the shift # we need to null-position the moved row if the position column is part of a constraint - if (grep { $_ eq $position_column } ( map { @$_ } (values %{{ $self->result_source->unique_constraints }} ) ) ) { + if (grep { $_ eq $position_column } ( map { @$_ } (values %{{ $rsrc->unique_constraints }} ) ) ) { $self->_ordered_internal_update({ $position_column => $self->null_position_value }); } $self->_shift_siblings ($direction, @between); $self->_ordered_internal_update({ $position_column => $new_pos_val }); - $guard->commit; + $guard->commit if $guard; return 1; } @@ -425,7 +481,7 @@ group, or to the end of the group if $position is undef. 1 is returned on success, and 0 is returned if the object is already at the specified position of the specified group. -$group may be specified as a single scalar if only one +$group may be specified as a single scalar if only one grouping column is in use, or as a hashref of column => value pairs if multiple grouping columns are in use. @@ -447,28 +503,13 @@ sub move_to_group { return 0 if ( defined($to_position) and $to_position < 1 ); # check if someone changed the _grouping_columns - this will - # prevent _is_in_group working, so we need to requery the db - # for the original values - my (@dirty_cols, %values, $guard); + # prevent _is_in_group working, so we need to restore the + # original stashed values for ($self->_grouping_columns) { - $values{$_} = $self->get_column ($_); - push @dirty_cols, $_ if $self->is_column_changed ($_); - } - - # re-query only the dirty columns, and restore them on the - # object (subsequent code will update them to the correct - # after-move values) - if (@dirty_cols) { - $guard = $self->result_source->schema->txn_scope_guard; - - my $cursor = $self->result_source->resultset->search( - $self->ident_condition, - { select => \@dirty_cols }, - )->cursor; - - my @original_values = $cursor->next; - $self->set_inflated_columns ({ %values, map { $_ => shift @original_values } (@dirty_cols) }); - delete $self->{_dirty_columns}{$_} for (@dirty_cols); + if ($self->is_column_changed ($_)) { + $self->store_column($_, delete $self->{_column_data_in_storage}{$_}); + delete $self->{_dirty_columns}{$_}; + } } if ($self->_is_in_group ($to_group) ) { @@ -477,11 +518,10 @@ sub move_to_group { $ret = $self->move_to ($to_position); } - $guard->commit if $guard; return $ret||0; } - $guard ||= $self->result_source->schema->txn_scope_guard; + my $guard = $self->result_source->schema->txn_scope_guard; # Move to end of current group to adjust siblings $self->move_last; @@ -515,8 +555,8 @@ sub move_to_group { =head2 insert -Overrides the DBIC insert() method by providing a default -position number. The default will be the number of rows in +Overrides the DBIC insert() method by providing a default +position number. The default will be the number of rows in the table +1, thus positioning the new record at the last position. =cut @@ -549,104 +589,52 @@ of a new group if it has been changed to undef. =cut sub update { - my $self = shift; - - # this is set by _ordered_internal_update() - return $self->next::method(@_) if $self->{_ORDERED_INTERNAL_UPDATE}; - - my $position_column = $self->position_column; - my @ordering_columns = ($self->_grouping_columns, $position_column); - - - # these steps are necessary to keep the external appearance of - # ->update($upd) so that other things overloading update() will - # work properly - my %original_values = $self->get_columns; - my %existing_changes = $self->get_dirty_columns; - - # See if any of the *supplied* changes would affect the ordering - # The reason this is so contrived, is that we want to leverage - # the datatype aware value comparing, while at the same time - # keep the original value intact (it will be updated later by the - # corresponding routine) - - my %upd = %{shift || {}}; - my %changes = %existing_changes; - - for (@ordering_columns) { - next unless exists $upd{$_}; - - # we do not want to keep propagating this to next::method - # as it will be a done deal by the time get there - my $value = delete $upd{$_}; - $self->set_inflated_columns ({ $_ => $value }); - - # see if an update resulted in a dirty column - # it is important to preserve the old value, as it - # will be needed to carry on a successfull move() - # operation without re-querying the database - if ($self->is_column_changed ($_) && not exists $existing_changes{$_}) { - $changes{$_} = $value; - $self->set_inflated_columns ({ $_ => $original_values{$_} }); - delete $self->{_dirty_columns}{$_}; - } - } - - # if nothing group/position related changed - short circuit - if (not grep { exists $changes{$_} } ( @ordering_columns ) ) { - return $self->next::method( \%upd, @_ ); - } - - { - my $guard = $self->result_source->schema->txn_scope_guard; - - # if any of our grouping columns have been changed - if (grep { exists $changes{$_} } ($self->_grouping_columns) ) { - - # create new_group by taking the current group and inserting changes - my $new_group = {$self->_grouping_clause}; - foreach my $col (keys %$new_group) { - $new_group->{$col} = $changes{$col} if exists $changes{$col}; - } - - $self->move_to_group( - $new_group, - (exists $changes{$position_column} - # The FIXME bit contradicts the documentation: POD states that - # when changing groups without supplying explicit positions in - # move_to_group(), we push the item to the end of the group. - # However when I was rewriting this, the position from the old - # group was clearly passed to the new one - # Probably needs to go away (by ribasushi) - ? $changes{$position_column} # means there was a position change supplied with the update too - : $self->_position # FIXME! (replace with undef) - ), - ); - } - elsif (exists $changes{$position_column}) { - $self->move_to($changes{$position_column}); - } - - my @res; - my $want = wantarray(); - if (not defined $want) { - $self->next::method( \%upd, @_ ); - } - elsif ($want) { - @res = $self->next::method( \%upd, @_ ); - } - else { - $res[0] = $self->next::method( \%upd, @_ ); - } + my $self = shift; + + # this is set by _ordered_internal_update() + return $self->next::method(@_) if $self->result_source->schema->{_ORDERED_INTERNAL_UPDATE}; + + my $upd = shift; + $self->set_inflated_columns($upd) if $upd; + + my $position_column = $self->position_column; + my @group_columns = $self->_grouping_columns; + + # see if the order is already changed + my $changed_ordering_cols = { map { $_ => $self->get_column($_) } grep { $self->is_column_changed($_) } ($position_column, @group_columns) }; + + # nothing changed - short circuit + if (! keys %$changed_ordering_cols) { + return $self->next::method( undef, @_ ); + } + elsif (grep { exists $changed_ordering_cols->{$_} } @group_columns ) { + $self->move_to_group( + # since the columns are already re-set the _grouping_clause is correct + # move_to_group() knows how to get the original storage values + { $self->_grouping_clause }, + + # The FIXME bit contradicts the documentation: POD states that + # when changing groups without supplying explicit positions in + # move_to_group(), we push the item to the end of the group. + # However when I was rewriting this, the position from the old + # group was clearly passed to the new one + # Probably needs to go away (by ribasushi) + (exists $changed_ordering_cols->{$position_column} + ? $changed_ordering_cols->{$position_column} # means there was a position change supplied with the update too + : $self->_position # FIXME! (replace with undef) + ), + ); + } + else { + $self->move_to($changed_ordering_cols->{$position_column}); + } - $guard->commit; - return $want ? @res : $res[0]; - } + return $self; } =head2 delete -Overrides the DBIC delete() method by first moving the object +Overrides the DBIC delete() method by first moving the object to the last position, then deleting it, thus ensuring the integrity of the positions. @@ -659,20 +647,21 @@ sub delete { $self->move_last; - my @res; - my $want = wantarray(); - if (not defined $want) { - $self->next::method( @_ ); - } - elsif ($want) { - @res = $self->next::method( @_ ); - } - else { - $res[0] = $self->next::method( @_ ); - } + $self->next::method( @_ ); $guard->commit; - return $want ? @res : $res[0]; + + return $self; +} + +# add the current position/group to the things we track old values for +sub _track_storage_value { + my ($self, $col) = @_; + return ( + $self->next::method($col) + || + grep { $_ eq $col } ($self->position_column, $self->_grouping_columns) + ); } =head1 METHODS FOR EXTENDING ORDERED @@ -736,7 +725,7 @@ L below. Defaults to 1. =cut -__PACKAGE__->mk_classdata( '_initial_position_value' => 1 ); +__PACKAGE__->mk_classaccessor( '_initial_position_value' => 1 ); =head2 _next_position_value @@ -761,11 +750,11 @@ sub _next_position_value { Shifts all siblings with B in the range @between (inclusive) by one position as specified by $direction (left if < 0, right if > 0). By default simply increments/decrements each -L value by 1, doing so in a way as to not violate +L value by 1, doing so in a way as to not violate any existing constraints. Note that if you override this method and have unique constraints -including the L the shift is not a trivial task. +including the L the shift is not a trivial task. Refer to the implementation source of the default method for more information. @@ -788,27 +777,25 @@ sub _shift_siblings { my $shift_rs = $self->_group_rs-> search ({ $position_column => { -between => \@between } }); - # some databases (sqlite) are dumb and can not do a blanket - # increment/decrement. So what we do here is check if the - # position column is part of a unique constraint, and do a - # one-by-one update if this is the case - + # some databases (sqlite, pg, perhaps others) are dumb and can not do a + # blanket increment/decrement without violating a unique constraint. + # So what we do here is check if the position column is part of a unique + # constraint, and do a one-by-one update if this is the case. my $rsrc = $self->result_source; - if (grep { $_ eq $position_column } ( map { @$_ } (values %{{ $rsrc->unique_constraints }} ) ) ) { - - my @pcols = $rsrc->primary_columns; - my $cursor = $shift_rs->search ({}, { order_by => { "-$ord", $position_column }, columns => \@pcols } )->cursor; - my $rs = $self->result_source->resultset; - - while (my @pks = $cursor->next ) { - - my $cond; - for my $i (0.. $#pcols) { - $cond->{$pcols[$i]} = $pks[$i]; - } - - $rs->search($cond)->update ({ $position_column => \ "$position_column $op 1" } ); + # set in case there are more cascades combined with $rs->update => $rs_update_all overrides + local $rsrc->schema->{_ORDERED_INTERNAL_UPDATE} = 1; + my @pcols = $rsrc->primary_columns; + if ( + grep { $_ eq $position_column } ( map { @$_ } (values %{{ $rsrc->unique_constraints }} ) ) + ) { + my $clean_rs = $rsrc->resultset; + + for ( $shift_rs->search ( + {}, { order_by => { "-$ord", $position_column }, select => [$position_column, @pcols] } + )->cursor->all ) { + my $pos = shift @$_; + $clean_rs->find(@$_)->update ({ $position_column => $pos + ( ($op eq '+') ? 1 : -1 ) }); } } else { @@ -816,68 +803,66 @@ sub _shift_siblings { } } -=head1 PRIVATE METHODS - -These methods are used internally. You should never have the -need to use them. - -=head2 _group_rs -This method returns a resultset containing all members of the row -group (including the row itself). - -=cut +# This method returns a resultset containing all members of the row +# group (including the row itself). sub _group_rs { - my $self = shift; - return $self->result_source->resultset->search({$self->_grouping_clause()}); + #my $self = shift; + + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS + and + wantarray + and + ! eval { fail_on_internal_call; 1 } + and + die "ILLEGAL LIST CONTEXT INVOCATION: $@"; + + # *MUST* be context sensitive due to legacy (DO NOT call search_rs) + $_[0]->result_source->resultset->search({ $_[0]->_grouping_clause() }); } -=head2 _siblings - -Returns an unordered resultset of all objects in the same group -excluding the object you called this method on. - -=cut +# Returns an unordered resultset of all objects in the same group +# excluding the object you called this method on. sub _siblings { my $self = shift; my $position_column = $self->position_column; - return $self->_group_rs->search( - { $position_column => { '!=' => $self->get_column($position_column) } }, - ); + my $pos; + + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS + and + wantarray + and + ! eval { fail_on_internal_call; 1 } + and + die "ILLEGAL LIST CONTEXT INVOCATION: $@"; + + # *MUST* be context sensitive due to legacy (DO NOT call search_rs) + defined( $pos = $self->get_column($position_column) ) + ? $self->_group_rs->search( + { $position_column => { '!=' => $pos } }, + ) + : $self->_group_rs + ; } -=head2 _position - - my $num_pos = $item->_position; - -Returns the B of the current object, with the -first object being at position 1, its sibling at position 2 and so on. - -=cut +# Returns the B of the current object, with the +# first object being at position 1, its sibling at position 2 and so on. sub _position { my $self = shift; return $self->_position_from_value ($self->get_column ($self->position_column) ); } -=head2 _grouping_clause - -This method returns one or more name=>value pairs for limiting a search -by the grouping column(s). If the grouping column is not defined then -this will return an empty list. - -=cut +# This method returns one or more name=>value pairs for limiting a search +# by the grouping column(s). If the grouping column is not defined then +# this will return an empty list. sub _grouping_clause { my( $self ) = @_; return map { $_ => $self->get_column($_) } $self->_grouping_columns(); } -=head2 _get_grouping_columns - -Returns a list of the column names used for grouping, regardless of whether -they were specified as an arrayref or a single string, and returns () -if there is no grouping. - -=cut +# Returns a list of the column names used for grouping, regardless of whether +# they were specified as an arrayref or a single string, and returns () +# if there is no grouping. sub _grouping_columns { my( $self ) = @_; my $col = $self->grouping_column(); @@ -890,51 +875,48 @@ sub _grouping_columns { } } -=head2 _is_in_group - - $item->_is_in_group( {user => 'fred', list => 'work'} ) - -Returns true if the object is in the group represented by hashref $other - -=cut +# Returns true if the object is in the group represented by hashref $other sub _is_in_group { my ($self, $other) = @_; my $current = {$self->_grouping_clause}; - no warnings qw/uninitialized/; - - return 0 if ( - join ("\x00", sort keys %$current) - ne - join ("\x00", sort keys %$other) - ); - for my $key (keys %$current) { - return 0 if $current->{$key} ne $other->{$key}; - } - return 1; + ( + bag_eq( + [ keys %$current ], + [ keys %$other ], + ) + and + ! grep { + ( + defined( $current->{$_} ) + xor + defined( $other->{$_} ) + ) + or + ( + defined $current->{$_} + and + $current->{$_} ne $other->{$_} + ) + } keys %$other + ) ? 1 : 0; } -=head2 _ordered_internal_update - -This is a short-circuited method, that is used internally by this -module to update positioning values in isolation (i.e. without -triggering any of the positioning integrity code). - -Some day you might get confronted by datasets that have ambiguous -positioning data (e.g. duplicate position values within the same group, -in a table without unique constraints). When manually fixing such data -keep in mind that you can not invoke L like -you normally would, as it will get confused by the wrong data before -having a chance to update the ill-defined row. If you really know what -you are doing use this method which bypasses any hooks introduced by -this module. - -=cut - +# This is a short-circuited method, that is used internally by this +# module to update positioning values in isolation (i.e. without +# triggering any of the positioning integrity code). +# +# Some day you might get confronted by datasets that have ambiguous +# positioning data (e.g. duplicate position values within the same group, +# in a table without unique constraints). When manually fixing such data +# keep in mind that you can not invoke L like +# you normally would, as it will get confused by the wrong data before +# having a chance to update the ill-defined row. If you really know what +# you are doing use this method which bypasses any hooks introduced by +# this module. sub _ordered_internal_update { - my $self = shift; - local $self->{_ORDERED_INTERNAL_UPDATE} = 1; - return $self->update (@_); + local $_[0]->result_source->schema->{_ORDERED_INTERNAL_UPDATE} = 1; + shift->update (@_); } 1; @@ -943,9 +925,23 @@ __END__ =head1 CAVEATS +=head2 Resultset Methods + +Note that all Insert/Create/Delete overrides are happening on +L methods only. If you use the +L versions of +L or +L, all logic present in this +module will be bypassed entirely (possibly resulting in a broken +order-tree). Instead always use the +L and +L methods, which will +invoke the corresponding L method on every +member of the given resultset. + =head2 Race Condition on Insert -If a position is not specified for an insert than a position +If a position is not specified for an insert, a position will be chosen based either on L or L, depending if there are already some items in the current group. The space of time between the @@ -956,33 +952,31 @@ will prevent such race conditions going undetected. =head2 Multiple Moves -Be careful when issuing move_* methods to multiple objects. If -you've pre-loaded the objects then when you move one of the objects -the position of the other object will not reflect their new value -until you reload them from the database - see -L. +If you have multiple same-group result objects already loaded from storage, +you need to be careful when executing C operations on them: +without a L reload the L of the +"siblings" will be out of sync with the underlying storage. -There are times when you will want to move objects as groups, such -as changing the parent of several objects at once - this directly -conflicts with this problem. One solution is for us to write a -ResultSet class that supports a parent() method, for example. Another -solution is to somehow automagically modify the objects that exist -in the current object's result set to have the new position value. +Starting from version C<0.082800> DBIC will implicitly perform such +reloads when the C happens as a part of a transaction +(a good example of such situation is C<< $ordered_resultset->delete_all >>). + +If it is not possible for you to wrap the entire call-chain in a transaction, +you will need to call L to get an object +up-to-date before proceeding, otherwise undefined behavior will result. =head2 Default Values Using a database defined default_value on one of your group columns could result in the position not being assigned correctly. -=head1 AUTHOR - - Original code framework - Aran Deltac - - Constraints support and code generalisation - Peter Rabbitson +=head1 FURTHER QUESTIONS? -=head1 LICENSE +Check the list of L. -You may distribute this code under the same terms as Perl itself. +=head1 COPYRIGHT AND LICENSE +This module is free software L +by the L. You can +redistribute it and/or modify it under the same terms as the +L.