Fixes and tests for next/previous _sibling.
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Positioned.pm
CommitLineData
118e6b96 1# vim: ts=8:sw=4:sts=4:et
2package DBIx::Class::Positioned;
3use strict;
4use warnings;
5use base qw( DBIx::Class );
6
7=head1 NAME
8
9DBIx::Class::Positioned - Modify the position of objects in an ordered list.
10
11=head1 SYNOPSIS
12
13Create a table for your positionable data.
14
15 CREATE TABLE employees (
16 employee_id INTEGER PRIMARY KEY AUTOINCREMENT,
17 name TEXT NOT NULL,
18 position INTEGER NOT NULL
19 );
20
21In your Schema or DB class add Positioned to the top
22of the component list.
23
24 __PACKAGE__->load_components(qw( Positioned ... ));
25
26Specify the column that stores the position number for
27each row.
28
29 package My::Employee;
30 __PACKAGE__->position_column('position');
31
32Thats it, now you can change the position of your objects.
33
34 #!/use/bin/perl
35 use My::Employee;
36
37 my $employee = My::Employee->create({ name=>'Matt S. Trout' });
38
39 my $rs = $employee->siblings();
40 my @siblings = $employee->siblings();
41
42 my $sibling;
43 $sibling = $employee->first_sibling();
44 $sibling = $employee->last_sibling();
45 $sibling = $employee->previous_sibling();
46 $sibling = $employee->next_sibling();
47
48 $employee->move_previous();
49 $employee->move_next();
50 $employee->move_first();
51 $employee->move_last();
52 $employee->move_to( $position );
53
54=head1 DESCRIPTION
55
56This module provides a simple interface for modifying the position
57of DBIx::Class objects.
58
133dd22a 59=head1 AUTO UPDATE
60
61All of the move_* methods automatically update the rows involved in
62the query. This is not configurable and is due to the fact that if you
63move a record it always causes other records in the list to be updated.
64
118e6b96 65=head1 METHODS
66
67=head2 position_column
68
69 __PACKAGE__->position_column('position');
70
71Sets and retrieves the name of the column that stores the
72positional value of each record. Default to "position".
73
74=cut
75
76__PACKAGE__->mk_classdata( 'position_column' => 'position' );
77
133dd22a 78=head2 collection_column
79
80 __PACKAGE__->collection_column('thing_id');
81
82This method specified a column to limit all queries in
83this module by. This effectively allows you to have multiple
84positioned lists within the same table.
85
86=cut
87
88__PACKAGE__->mk_classdata( 'collection_column' );
89
118e6b96 90=head2 siblings
91
92 my $rs = $employee->siblings();
93 my @siblings = $employee->siblings();
94
95Returns either a result set or an array of all other objects
96excluding the one you called it on.
97
98=cut
99
100sub siblings {
101 my( $self ) = @_;
102 my $position_column = $self->position_column;
103 my $rs = $self->search(
7a76f44c 104 {
105 $position_column => { '!=' => $self->get_column($position_column) },
133dd22a 106 $self->_collection_clause(),
7a76f44c 107 },
118e6b96 108 { order_by => $self->position_column },
109 );
7a76f44c 110 return $rs->all() if (wantarray());
111 return $rs;
118e6b96 112}
113
114=head2 first_sibling
115
116 my $sibling = $employee->first_sibling();
117
118Returns the first sibling object.
119
120=cut
121
122sub first_sibling {
123 my( $self ) = @_;
124 return ($self->search(
133dd22a 125 { $self->_collection_clause() },
118e6b96 126 { rows=>1, order_by => $self->position_column },
127 )->all())[0];
128}
129
130=head2 last_sibling
131
132 my $sibling = $employee->last_sibling();
133
134Return the last sibling.
135
136=cut
137
138sub last_sibling {
139 my( $self ) = @_;
140 return ($self->search(
133dd22a 141 { $self->_collection_clause() },
118e6b96 142 { rows=>1, order_by => $self->position_column.' DESC' },
143 )->all())[0];
144}
145
146=head2 previous_sibling
147
148 my $sibling = $employee->previous_sibling();
149
150Returns the sibling that resides one position higher. Undef
151is returned if the current object is the first one.
152
153=cut
154
155sub previous_sibling {
156 my( $self ) = @_;
157 my $position_column = $self->position_column;
707cbb2d 158 my $position = $self->get_column( $position_column );
159 return 0 if ($position==1);
118e6b96 160 return ($self->search(
7a76f44c 161 {
707cbb2d 162 $position_column => $position - 1,
133dd22a 163 $self->_collection_clause(),
707cbb2d 164 }
118e6b96 165 )->all())[0];
166}
167
168=head2 next_sibling
169
170 my $sibling = $employee->next_sibling();
171
172Returns the sibling that resides one position lower. Undef
173is returned if the current object is the last one.
174
175=cut
176
177sub next_sibling {
178 my( $self ) = @_;
179 my $position_column = $self->position_column;
707cbb2d 180 my $position = $self->get_column( $position_column );
181 my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
182 return 0 if ($position==$count);
133dd22a 183 return ($self->result_source->resultset->search(
7a76f44c 184 {
707cbb2d 185 $position_column => $position + 1,
133dd22a 186 $self->_collection_clause(),
7a76f44c 187 },
118e6b96 188 )->all())[0];
189}
190
80010e2b 191=head2 move_previous
118e6b96 192
80010e2b 193 $employee->move_previous();
118e6b96 194
80010e2b 195Swaps position with the sibling on position previous in the list.
1961 is returned on success, and 0 is returned if the objects is already
197the first one.
118e6b96 198
199=cut
200
80010e2b 201sub move_previous {
118e6b96 202 my( $self ) = @_;
133dd22a 203 my $position = $self->get_column( $self->position_column() );
204 return $self->move_to( $position - 1 );
118e6b96 205}
206
80010e2b 207=head2 move_next
118e6b96 208
80010e2b 209 $employee->move_next();
118e6b96 210
80010e2b 211Swaps position with the sibling in the next position. 1 is returned on
212success, and 0 is returned if the object is already the last in the list.
118e6b96 213
214=cut
215
80010e2b 216sub move_next {
118e6b96 217 my( $self ) = @_;
133dd22a 218 my $position = $self->get_column( $self->position_column() );
219 my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
220 return 0 if ($position==$count);
221 return $self->move_to( $position + 1 );
118e6b96 222}
223
224=head2 move_first
225
226 $employee->move_first();
227
228Moves the object to the first position. 1 is returned on
229success, and 0 is returned if the object is already the first.
230
231=cut
232
233sub move_first {
234 my( $self ) = @_;
235 return $self->move_to( 1 );
236}
237
238=head2 move_last
239
240 $employee->move_last();
241
242Moves the object to the very last position. 1 is returned on
243success, and 0 is returned if the object is already the last one.
244
245=cut
246
247sub move_last {
248 my( $self ) = @_;
133dd22a 249 my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
118e6b96 250 return $self->move_to( $count );
251}
252
253=head2 move_to
254
255 $employee->move_to( $position );
256
257Moves the object to the specified position. 1 is returned on
258success, and 0 is returned if the object is already at the
259specified position.
260
261=cut
262
263sub move_to {
264 my( $self, $to_position ) = @_;
265 my $position_column = $self->position_column;
266 my $from_position = $self->get_column( $position_column );
133dd22a 267 return 0 if ( $to_position < 1 );
268 return 0 if ( $from_position==$to_position );
269 my $rs = $self->result_source->resultset->search({
118e6b96 270 -and => [
271 $position_column => { ($from_position>$to_position?'<':'>') => $from_position },
272 $position_column => { ($from_position>$to_position?'>=':'<=') => $to_position },
7a76f44c 273 ],
133dd22a 274 $self->_collection_clause(),
118e6b96 275 });
276 my $op = ($from_position>$to_position) ? '+' : '-';
277 $rs->update({
278 $position_column => \"$position_column $op 1",
279 });
280 $self->set_column( $position_column => $to_position );
281 $self->update();
282 return 1;
283}
284
285=head2 insert
286
287Overrides the DBIC insert() method by providing a default
288position number. The default will be the number of rows in
289the table +1, thus positioning the new record at the last position.
290
291=cut
292
293sub insert {
294 my $self = shift;
295 my $position_column = $self->position_column;
133dd22a 296 $self->set_column( $position_column => $self->result_source->resultset->search( {$self->_collection_clause()} )->count()+1 )
118e6b96 297 if (!$self->get_column($position_column));
298 $self->next::method( @_ );
299}
300
301=head2 delete
302
303Overrides the DBIC delete() method by first moving the object
304to the last position, then deleting it, thus ensuring the
305integrity of the positions.
306
307=cut
308
309sub delete {
310 my $self = shift;
311 $self->move_last;
312 $self->next::method( @_ );
313}
314
7a76f44c 315=head1 PRIVATE METHODS
316
317These methods are used internally. You should never have the
318need to use them.
319
133dd22a 320=head2 _collection_clause
118e6b96 321
133dd22a 322This method returns a name=>value pare for limiting a search
323by the collection column. If the collection column is not
324defined then this will return an empty list.
118e6b96 325
7a76f44c 326=cut
327
133dd22a 328sub _collection_clause {
329 my $self = shift;
330 if ($self->collection_column()) {
331 return ( $self->collection_column() => $self->get_column($self->collection_column()) );
332 }
7a76f44c 333 return ();
334}
335
3361;
337__END__
118e6b96 338
339=head1 BUGS
340
133dd22a 341=head2 Race Condition on Insert
342
118e6b96 343If a position is not specified for an insert than a position
344will be chosen based on COUNT(*)+1. But, it first selects the
345count then inserts the record. The space of time between select
346and insert introduces a race condition. To fix this we need the
347ability to lock tables in DBIC. I've added an entry in the TODO
348about this.
349
133dd22a 350=head2 Multiple Moves
351
352Be careful when issueing move_* methods to multiple objects. If
353you've pre-loaded the objects then when you move one of the objects
354the position of the other object will not reflect their new value
355until you reload them from the database.
356
357The are times when you will want to move objects as groups, such
358as changeing the parent of several objects at once - this directly
359conflicts with this problem. One solution is for us to write a
360ResultSet class that supports a parent() method, for example. Another
361solution is to somehow automagically modify the objects that exist
362in the current object's result set to have the new position value.
363
118e6b96 364=head1 AUTHOR
365
366Aran Deltac <bluefeet@cpan.org>
367
368=head1 LICENSE
369
370You may distribute this code under the same terms as Perl itself.
371