[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Ordered.pm

# vim: ts=8:sw=4:sts=4:et
package DBIx::Class::Ordered;
use strict;
use warnings;
use base qw( DBIx::Class );

=head1 NAME

DBIx::Class::Ordered - Modify the position of objects in an ordered list.

=head1 SYNOPSIS

Create a table for your ordered data.

  CREATE TABLE items (
    item_id INTEGER PRIMARY KEY AUTOINCREMENT,
    name TEXT NOT NULL,
    position INTEGER NOT NULL
  );
  # Optional: group_id INTEGER NOT NULL

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 
each row.

  package My::Item;
  __PACKAGE__->position_column('position');
  __PACKAGE__->grouping_column('group_id'); # optional

Thats it, now you can change the position of your objects.

  #!/use/bin/perl
  use My::Item;
  
  my $item = My::Item->create({ name=>'Matt S. Trout' });
  # If using grouping_column:
  my $item = My::Item->create({ name=>'Matt S. Trout', group_id=>1 });
  
  my $rs = $item->siblings();
  my @siblings = $item->siblings();
  
  my $sibling;
  $sibling = $item->first_sibling();
  $sibling = $item->last_sibling();
  $sibling = $item->previous_sibling();
  $sibling = $item->next_sibling();
  
  $item->move_previous();
  $item->move_next();
  $item->move_first();
  $item->move_last();
  $item->move_to( $position );

=head1 DESCRIPTION

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 
move a record it always causes other records in the list to be updated.

=head1 METHODS

=head2 position_column

  __PACKAGE__->position_column('position');

Sets and retrieves the name of the column that stores the 
positional value of each record.  Default to "position".

=cut

__PACKAGE__->mk_classdata( 'position_column' => 'position' );

=head2 grouping_column

  __PACKAGE__->grouping_column('group_id');

This method specified 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' );

=head2 siblings

  my $rs = $item->siblings();
  my @siblings = $item->siblings();

Returns either a result set or an array of all other objects 
excluding the one you called it on.

=cut

sub siblings {
    my( $self ) = @_;
    my $position_column = $self->position_column;
    my $rs = $self->result_source->resultset->search(
        {
            $position_column => { '!=' => $self->get_column($position_column) },
            $self->_grouping_clause(),
        },
        { order_by => $self->position_column },
    );
    return $rs->all() if (wantarray());
    return $rs;
}

=head2 first_sibling

  my $sibling = $item->first_sibling();

Returns the first sibling object, or 0 if the first sibling 
is this sibliing.

=cut

sub first_sibling {
    my( $self ) = @_;
    return 0 if ($self->get_column($self->position_column())==1);
    return ($self->result_source->resultset->search(
        {
            $self->position_column => 1,
            $self->_grouping_clause(),
        },
    )->all())[0];
}

=head2 last_sibling

  my $sibling = $item->last_sibling();

Return the last sibling, or 0 if the last sibling is this 
sibling.

=cut

sub last_sibling {
    my( $self ) = @_;
    my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
    return 0 if ($self->get_column($self->position_column())==$count);
    return ($self->result_source->resultset->search(
        {
            $self->position_column => $count,
            $self->_grouping_clause(),
        },
    )->all())[0];
}

=head2 previous_sibling

  my $sibling = $item->previous_sibling();

Returns the sibling that resides one position back.  Undef 
is returned if the current object is the first one.

=cut

sub previous_sibling {
    my( $self ) = @_;
    my $position_column = $self->position_column;
    my $position = $self->get_column( $position_column );
    return 0 if ($position==1);
    return ($self->result_source->resultset->search(
        {
            $position_column => $position - 1,
            $self->_grouping_clause(),
        }
    )->all())[0];
}

=head2 next_sibling

  my $sibling = $item->next_sibling();

Returns the sibling that resides one position foward.  Undef 
is returned if the current object is the last one.

=cut

sub next_sibling {
    my( $self ) = @_;
    my $position_column = $self->position_column;
    my $position = $self->get_column( $position_column );
    my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
    return 0 if ($position==$count);
    return ($self->result_source->resultset->search(
        {
            $position_column => $position + 1,
            $self->_grouping_clause(),
        },
    )->all())[0];
}

=head2 move_previous

  $item->move_previous();

Swaps position with the sibling on position previous in the list.  
1 is returned on success, and 0 is returned if the objects is already 
the first one.

=cut

sub move_previous {
    my( $self ) = @_;
    my $position = $self->get_column( $self->position_column() );
    return $self->move_to( $position - 1 );
}

=head2 move_next

  $item->move_next();

Swaps position with the sibling in the next position.  1 is returned on 
success, and 0 is returned if the object is already the last in the list.

=cut

sub move_next {
    my( $self ) = @_;
    my $position = $self->get_column( $self->position_column() );
    my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
    return 0 if ($position==$count);
    return $self->move_to( $position + 1 );
}

=head2 move_first

  $item->move_first();

Moves the object to the first position.  1 is returned on 
success, and 0 is returned if the object is already the first.

=cut

sub move_first {
    my( $self ) = @_;
    return $self->move_to( 1 );
}

=head2 move_last

  $item->move_last();

Moves the object to the very last position.  1 is returned on 
success, and 0 is returned if the object is already the last one.

=cut

sub move_last {
    my( $self ) = @_;
    my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
    return $self->move_to( $count );
}

=head2 move_to

  $item->move_to( $position );

Moves the object to the specified position.  1 is returned on 
success, and 0 is returned if the object is already at the 
specified position.

=cut

sub move_to {
    my( $self, $to_position ) = @_;
    my $position_column = $self->position_column;
    my $from_position = $self->get_column( $position_column );
    return 0 if ( $to_position < 1 );
    return 0 if ( $from_position==$to_position );
    my @between = (
        ( $from_position < $to_position )
        ? ( $from_position+1, $to_position )
        : ( $to_position, $from_position-1 )
    );
    my $rs = $self->result_source->resultset->search({
        $position_column => { -between => [ @between ] },
        $self->_grouping_clause(),
    });
    my $op = ($from_position>$to_position) ? '+' : '-';
    $rs->update({ $position_column => \"$position_column $op 1" });
    $self->{_ORDERED_INTERNAL_UPDATE} = 1;
    $self->update({ $position_column => $to_position });
    return 1;
}

=head2 move_to_group

  $item->move_to_group( $group, $position );

Moves the object to the specified position of the specified
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.

=cut

sub move_to_group {
    my( $self, $to_group, $to_position ) = @_;
    my $position_column = $self->position_column;
    my $grouping_column = $self->grouping_column;

    return 0 if ( ! defined($to_group) );
    return 0 if ( defined($to_position) and $to_position < 1 );
    return 0 if ( $self->$grouping_column==$to_group and defined($to_position) and $self->$position_column==$to_position );

    # Move to end of current group and adjust siblings
    $self->move_last;

    $self->$grouping_column($to_group);
    my $new_group_count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
    if (!defined($to_position) or $to_position > $new_group_count) {
        $self->{_ORDERED_INTERNAL_UPDATE} = 1;
        $self->update({ $position_column => $new_group_count + 1 });
    }
    else {
        my @between = ($to_position, $new_group_count);

        my $rs = $self->result_source->resultset->search({
            $position_column => { -between => [ @between ] },
            $self->_grouping_clause(),
        });
        $rs->update({ $position_column => \"$position_column + 1" });
        $self->{_ORDERED_INTERNAL_UPDATE} = 1;
        $self->update({ $position_column => $to_position });
    }

    return 1;
}

=head2 insert

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

sub insert {
    my $self = shift;
    my $position_column = $self->position_column;
    $self->set_column( $position_column => $self->result_source->resultset->search( {$self->_grouping_clause()} )->count()+1 ) 
        if (!$self->get_column($position_column));
    return $self->next::method( @_ );
}

=head2 update

Overrides the DBIC update() method by checking for a change
to the position and/or group columns.  Movement within a
group or to another group is handled by repositioning
the appropriate siblings.  Position defaults to the end
of a new group if it has been changed to undef.

=cut

sub update {
    my $self = shift;

    if ($self->{_ORDERED_INTERNAL_UPDATE}) {
        delete $self->{_ORDERED_INTERNAL_UPDATE};
        return $self->next::method( @_ );
    }

    $self->set_columns($_[0]) if @_ > 0;
    my %changes = $self->get_dirty_columns;
    $self->discard_changes;

    my $pos_col = $self->position_column;
    my $grp_col = $self->grouping_column;
    if (defined($grp_col) and exists $changes{$grp_col}) {
        $self->move_to_group(
            delete($changes{$grp_col}),
            exists($changes{$pos_col}) ? delete($changes{$pos_col}) : $self->$pos_col
        );
    }
    elsif (exists $changes{$pos_col}) {
        $self->move_to(delete $changes{$pos_col});
    }
    return $self->next::method( \%changes );
}

=head2 delete

Overrides the DBIC delete() method by first moving the object 
to the last position, then deleting it, thus ensuring the 
integrity of the positions.

=cut

sub delete {
    my $self = shift;
    $self->move_last;
    return $self->next::method( @_ );
}

=head1 PRIVATE METHODS

These methods are used internally.  You should never have the 
need to use them.

=head2 _grouping_clause

This method returns a name=>value pare for limiting a search 
by the collection column.  If the collection column is not 
defined then this will return an empty list.

=cut

sub _grouping_clause {
    my( $self ) = @_;
    my $col = $self->grouping_column();
    if ($col) {
        return ( $col => $self->get_column($col) );
    }
    return ();
}

1;
__END__

=head1 BUGS

=head2 Unique Constraints

Unique indexes and constraints on the position column are not 
supported at this time.  It would be make sense to support them, 
but there are some unexpected database issues that make this 
hard to do.  The main problem from the author's view is that 
SQLite (the DB engine that we use for testing) does not support 
ORDER BY on updates.

=head2 Race Condition on Insert

If a position is not specified for an insert than a position 
will be chosen based on COUNT(*)+1.  But, it first selects the 
count then inserts the record.  The space of time between select 
and insert introduces a race condition.  To fix this we need the 
ability to lock tables in DBIC.  I've added an entry in the TODO 
about this.

=head2 Multiple Moves

Be careful when issueing 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.

There are times when you will want to move objects as groups, such 
as changeing 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.

=head1 AUTHOR

Aran Deltac <bluefeet@cpan.org>

=head1 LICENSE

You may distribute this code under the same terms as Perl itself.
Commit	Line	Data
118e6b96	1	# vim: ts=8:sw=4:sts=4:et
a733c37f	2	package DBIx::Class::Ordered;
118e6b96	3	use strict;
	4	use warnings;
	5	use base qw( DBIx::Class );
	6
	7	=head1 NAME
	8
a733c37f	9	DBIx::Class::Ordered - Modify the position of objects in an ordered list.
118e6b96	10
	11	=head1 SYNOPSIS
	12
a733c37f	13	Create a table for your ordered data.
118e6b96	14
a733c37f	15	CREATE TABLE items (
a733c37f	16	item_id INTEGER PRIMARY KEY AUTOINCREMENT,
118e6b96	17	name TEXT NOT NULL,
	18	position INTEGER NOT NULL
	19	);
169bb185	20	# Optional: group_id INTEGER NOT NULL
118e6b96	21
a733c37f	22	In your Schema or DB class add Ordered to the top
118e6b96	23	of the component list.
118e6b96	24
a733c37f	25	__PACKAGE__->load_components(qw( Ordered ... ));
118e6b96	26
	27	Specify the column that stores the position number for
	28	each row.
	29
a733c37f	30	package My::Item;
118e6b96	31	__PACKAGE__->position_column('position');
a733c37f	32	__PACKAGE__->grouping_column('group_id'); # optional
118e6b96	33
	34	Thats it, now you can change the position of your objects.
	35
	36	#!/use/bin/perl
a733c37f	37	use My::Item;
118e6b96	38
a733c37f	39	my $item = My::Item->create({ name=>'Matt S. Trout' });
	40	# If using grouping_column:
	41	my $item = My::Item->create({ name=>'Matt S. Trout', group_id=>1 });
118e6b96	42
a733c37f	43	my $rs = $item->siblings();
a733c37f	44	my @siblings = $item->siblings();
118e6b96	45
118e6b96	46	my $sibling;
a733c37f	47	$sibling = $item->first_sibling();
	48	$sibling = $item->last_sibling();
	49	$sibling = $item->previous_sibling();
	50	$sibling = $item->next_sibling();
118e6b96	51
a733c37f	52	$item->move_previous();
	53	$item->move_next();
	54	$item->move_first();
	55	$item->move_last();
	56	$item->move_to( $position );
118e6b96	57
	58	=head1 DESCRIPTION
	59
a733c37f	60	This module provides a simple interface for modifying the ordered
a733c37f	61	position of DBIx::Class objects.
118e6b96	62
133dd22a	63	=head1 AUTO UPDATE
	64
	65	All of the move_* methods automatically update the rows involved in
	66	the query. This is not configurable and is due to the fact that if you
	67	move a record it always causes other records in the list to be updated.
	68
118e6b96	69	=head1 METHODS
	70
	71	=head2 position_column
	72
	73	__PACKAGE__->position_column('position');
	74
	75	Sets and retrieves the name of the column that stores the
	76	positional value of each record. Default to "position".
	77
	78	=cut
	79
	80	__PACKAGE__->mk_classdata( 'position_column' => 'position' );
	81
a733c37f	82	=head2 grouping_column
133dd22a	83
a733c37f	84	__PACKAGE__->grouping_column('group_id');
133dd22a	85
	86	This method specified a column to limit all queries in
	87	this module by. This effectively allows you to have multiple
a733c37f	88	ordered lists within the same table.
133dd22a	89
	90	=cut
	91
a733c37f	92	__PACKAGE__->mk_classdata( 'grouping_column' );
133dd22a	93
118e6b96	94	=head2 siblings
118e6b96	95
a733c37f	96	my $rs = $item->siblings();
a733c37f	97	my @siblings = $item->siblings();
118e6b96	98
	99	Returns either a result set or an array of all other objects
	100	excluding the one you called it on.
	101
	102	=cut
	103
	104	sub siblings {
	105	my( $self ) = @_;
	106	my $position_column = $self->position_column;
a9cdbec2	107	my $rs = $self->result_source->resultset->search(
7a76f44c	108	{
7a76f44c	109	$position_column => { '!=' => $self->get_column($position_column) },
a733c37f	110	$self->_grouping_clause(),
7a76f44c	111	},
118e6b96	112	{ order_by => $self->position_column },
118e6b96	113	);
7a76f44c	114	return $rs->all() if (wantarray());
7a76f44c	115	return $rs;
118e6b96	116	}
	117
	118	=head2 first_sibling
	119
a733c37f	120	my $sibling = $item->first_sibling();
118e6b96	121
5faa95af	122	Returns the first sibling object, or 0 if the first sibling
5faa95af	123	is this sibliing.
118e6b96	124
	125	=cut
	126
	127	sub first_sibling {
	128	my( $self ) = @_;
5faa95af	129	return 0 if ($self->get_column($self->position_column())==1);
a9cdbec2	130	return ($self->result_source->resultset->search(
	131	{
	132	$self->position_column => 1,
a733c37f	133	$self->_grouping_clause(),
a9cdbec2	134	},
118e6b96	135	)->all())[0];
	136	}
	137
	138	=head2 last_sibling
	139
a733c37f	140	my $sibling = $item->last_sibling();
118e6b96	141
5faa95af	142	Return the last sibling, or 0 if the last sibling is this
5faa95af	143	sibling.
118e6b96	144
	145	=cut
	146
	147	sub last_sibling {
	148	my( $self ) = @_;
a733c37f	149	my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
5faa95af	150	return 0 if ($self->get_column($self->position_column())==$count);
a9cdbec2	151	return ($self->result_source->resultset->search(
	152	{
	153	$self->position_column => $count,
a733c37f	154	$self->_grouping_clause(),
a9cdbec2	155	},
118e6b96	156	)->all())[0];
	157	}
	158
	159	=head2 previous_sibling
	160
a733c37f	161	my $sibling = $item->previous_sibling();
118e6b96	162
a733c37f	163	Returns the sibling that resides one position back. Undef
118e6b96	164	is returned if the current object is the first one.
	165
	166	=cut
	167
	168	sub previous_sibling {
	169	my( $self ) = @_;
	170	my $position_column = $self->position_column;
707cbb2d	171	my $position = $self->get_column( $position_column );
707cbb2d	172	return 0 if ($position==1);
3ffca97b	173	return ($self->result_source->resultset->search(
7a76f44c	174	{
707cbb2d	175	$position_column => $position - 1,
a733c37f	176	$self->_grouping_clause(),
707cbb2d	177	}
118e6b96	178	)->all())[0];
	179	}
	180
	181	=head2 next_sibling
	182
a733c37f	183	my $sibling = $item->next_sibling();
118e6b96	184
a733c37f	185	Returns the sibling that resides one position foward. Undef
118e6b96	186	is returned if the current object is the last one.
	187
	188	=cut
	189
	190	sub next_sibling {
	191	my( $self ) = @_;
	192	my $position_column = $self->position_column;
707cbb2d	193	my $position = $self->get_column( $position_column );
a733c37f	194	my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
707cbb2d	195	return 0 if ($position==$count);
133dd22a	196	return ($self->result_source->resultset->search(
7a76f44c	197	{
707cbb2d	198	$position_column => $position + 1,
a733c37f	199	$self->_grouping_clause(),
7a76f44c	200	},
118e6b96	201	)->all())[0];
	202	}
	203
80010e2b	204	=head2 move_previous
118e6b96	205
a733c37f	206	$item->move_previous();
118e6b96	207
80010e2b	208	Swaps position with the sibling on position previous in the list.
	209	1 is returned on success, and 0 is returned if the objects is already
	210	the first one.
118e6b96	211
	212	=cut
	213
80010e2b	214	sub move_previous {
118e6b96	215	my( $self ) = @_;
133dd22a	216	my $position = $self->get_column( $self->position_column() );
133dd22a	217	return $self->move_to( $position - 1 );
118e6b96	218	}
118e6b96	219
80010e2b	220	=head2 move_next
118e6b96	221
a733c37f	222	$item->move_next();
118e6b96	223
80010e2b	224	Swaps position with the sibling in the next position. 1 is returned on
80010e2b	225	success, and 0 is returned if the object is already the last in the list.
118e6b96	226
	227	=cut
	228
80010e2b	229	sub move_next {
118e6b96	230	my( $self ) = @_;
133dd22a	231	my $position = $self->get_column( $self->position_column() );
a733c37f	232	my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
133dd22a	233	return 0 if ($position==$count);
133dd22a	234	return $self->move_to( $position + 1 );
118e6b96	235	}
	236
	237	=head2 move_first
	238
a733c37f	239	$item->move_first();
118e6b96	240
	241	Moves the object to the first position. 1 is returned on
	242	success, and 0 is returned if the object is already the first.
	243
	244	=cut
	245
	246	sub move_first {
	247	my( $self ) = @_;
	248	return $self->move_to( 1 );
	249	}
	250
	251	=head2 move_last
	252
a733c37f	253	$item->move_last();
118e6b96	254
	255	Moves the object to the very last position. 1 is returned on
	256	success, and 0 is returned if the object is already the last one.
	257
	258	=cut
	259
	260	sub move_last {
	261	my( $self ) = @_;
a733c37f	262	my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
118e6b96	263	return $self->move_to( $count );
	264	}
	265
	266	=head2 move_to
	267
a733c37f	268	$item->move_to( $position );
118e6b96	269
	270	Moves the object to the specified position. 1 is returned on
	271	success, and 0 is returned if the object is already at the
	272	specified position.
	273
	274	=cut
	275
	276	sub move_to {
	277	my( $self, $to_position ) = @_;
	278	my $position_column = $self->position_column;
	279	my $from_position = $self->get_column( $position_column );
133dd22a	280	return 0 if ( $to_position < 1 );
133dd22a	281	return 0 if ( $from_position==$to_position );
dc66dea1	282	my @between = (
	283	( $from_position < $to_position )
	284	? ( $from_position+1, $to_position )
	285	: ( $to_position, $from_position-1 )
	286	);
133dd22a	287	my $rs = $self->result_source->resultset->search({
dc66dea1	288	$position_column => { -between => [ @between ] },
a733c37f	289	$self->_grouping_clause(),
118e6b96	290	});
118e6b96	291	my $op = ($from_position>$to_position) ? '+' : '-';
b1c66eea	292	$rs->update({ $position_column => \"$position_column $op 1" });
79dc353a	293	$self->{_ORDERED_INTERNAL_UPDATE} = 1;
b1c66eea	294	$self->update({ $position_column => $to_position });
118e6b96	295	return 1;
	296	}
	297
79dc353a	298	=head2 move_to_group
	299
	300	$item->move_to_group( $group, $position );
	301
	302	Moves the object to the specified position of the specified
	303	group, or to the end of the group if $position is undef.
	304	1 is returned on success, and 0 is returned if the object is
	305	already at the specified position of the specified group.
	306
	307	=cut
	308
	309	sub move_to_group {
	310	my( $self, $to_group, $to_position ) = @_;
	311	my $position_column = $self->position_column;
	312	my $grouping_column = $self->grouping_column;
	313
	314	return 0 if ( ! defined($to_group) );
	315	return 0 if ( defined($to_position) and $to_position < 1 );
	316	return 0 if ( $self->$grouping_column==$to_group and defined($to_position) and $self->$position_column==$to_position );
	317
	318	# Move to end of current group and adjust siblings
	319	$self->move_last;
	320
	321	$self->$grouping_column($to_group);
	322	my $new_group_count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
	323	if (!defined($to_position) or $to_position > $new_group_count) {
	324	$self->{_ORDERED_INTERNAL_UPDATE} = 1;
	325	$self->update({ $position_column => $new_group_count + 1 });
	326	}
	327	else {
	328	my @between = ($to_position, $new_group_count);
	329
	330	my $rs = $self->result_source->resultset->search({
	331	$position_column => { -between => [ @between ] },
	332	$self->_grouping_clause(),
	333	});
	334	$rs->update({ $position_column => \"$position_column + 1" });
	335	$self->{_ORDERED_INTERNAL_UPDATE} = 1;
	336	$self->update({ $position_column => $to_position });
	337	}
	338
	339	return 1;
	340	}
	341
118e6b96	342	=head2 insert
	343
	344	Overrides the DBIC insert() method by providing a default
	345	position number. The default will be the number of rows in
	346	the table +1, thus positioning the new record at the last position.
	347
	348	=cut
	349
	350	sub insert {
	351	my $self = shift;
	352	my $position_column = $self->position_column;
a733c37f	353	$self->set_column( $position_column => $self->result_source->resultset->search( {$self->_grouping_clause()} )->count()+1 )
118e6b96	354	if (!$self->get_column($position_column));
0a298c73	355	return $self->next::method( @_ );
118e6b96	356	}
118e6b96	357
79dc353a	358	=head2 update
	359
	360	Overrides the DBIC update() method by checking for a change
	361	to the position and/or group columns. Movement within a
	362	group or to another group is handled by repositioning
	363	the appropriate siblings. Position defaults to the end
	364	of a new group if it has been changed to undef.
	365
	366	=cut
	367
	368	sub update {
	369	my $self = shift;
	370
	371	if ($self->{_ORDERED_INTERNAL_UPDATE}) {
	372	delete $self->{_ORDERED_INTERNAL_UPDATE};
	373	return $self->next::method( @_ );
	374	}
	375
	376	$self->set_columns($_[0]) if @_ > 0;
	377	my %changes = $self->get_dirty_columns;
	378	$self->discard_changes;
	379
	380	my $pos_col = $self->position_column;
	381	my $grp_col = $self->grouping_column;
	382	if (defined($grp_col) and exists $changes{$grp_col}) {
	383	$self->move_to_group(
	384	delete($changes{$grp_col}),
	385	exists($changes{$pos_col}) ? delete($changes{$pos_col}) : $self->$pos_col
	386	);
	387	}
	388	elsif (exists $changes{$pos_col}) {
	389	$self->move_to(delete $changes{$pos_col});
	390	}
	391	return $self->next::method( \%changes );
	392	}
	393
118e6b96	394	=head2 delete
	395
	396	Overrides the DBIC delete() method by first moving the object
	397	to the last position, then deleting it, thus ensuring the
	398	integrity of the positions.
	399
	400	=cut
	401
	402	sub delete {
	403	my $self = shift;
	404	$self->move_last;
0a298c73	405	return $self->next::method( @_ );
118e6b96	406	}
118e6b96	407
7a76f44c	408	=head1 PRIVATE METHODS
	409
	410	These methods are used internally. You should never have the
	411	need to use them.
	412
a733c37f	413	=head2 _grouping_clause
118e6b96	414
133dd22a	415	This method returns a name=>value pare for limiting a search
	416	by the collection column. If the collection column is not
	417	defined then this will return an empty list.
118e6b96	418
7a76f44c	419	=cut
7a76f44c	420
a733c37f	421	sub _grouping_clause {
169bb185	422	my( $self ) = @_;
a733c37f	423	my $col = $self->grouping_column();
	424	if ($col) {
	425	return ( $col => $self->get_column($col) );
133dd22a	426	}
7a76f44c	427	return ();
	428	}
	429
	430	1;
	431	__END__
118e6b96	432
	433	=head1 BUGS
	434
dc66dea1	435	=head2 Unique Constraints
	436
	437	Unique indexes and constraints on the position column are not
	438	supported at this time. It would be make sense to support them,
	439	but there are some unexpected database issues that make this
	440	hard to do. The main problem from the author's view is that
	441	SQLite (the DB engine that we use for testing) does not support
	442	ORDER BY on updates.
	443
133dd22a	444	=head2 Race Condition on Insert
133dd22a	445
118e6b96	446	If a position is not specified for an insert than a position
	447	will be chosen based on COUNT(*)+1. But, it first selects the
	448	count then inserts the record. The space of time between select
	449	and insert introduces a race condition. To fix this we need the
	450	ability to lock tables in DBIC. I've added an entry in the TODO
	451	about this.
	452
133dd22a	453	=head2 Multiple Moves
	454
	455	Be careful when issueing move_* methods to multiple objects. If
	456	you've pre-loaded the objects then when you move one of the objects
	457	the position of the other object will not reflect their new value
	458	until you reload them from the database.
	459
dc66dea1	460	There are times when you will want to move objects as groups, such
133dd22a	461	as changeing the parent of several objects at once - this directly
	462	conflicts with this problem. One solution is for us to write a
	463	ResultSet class that supports a parent() method, for example. Another
	464	solution is to somehow automagically modify the objects that exist
	465	in the current object's result set to have the new position value.
	466
118e6b96	467	=head1 AUTHOR
	468
	469	Aran Deltac <bluefeet@cpan.org>
	470
	471	=head1 LICENSE
	472
	473	You may distribute this code under the same terms as Perl itself.
	474