remove_columns now deletes columns from _columns fixing has_columns false positives
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Ordered.pm
CommitLineData
118e6b96 1# vim: ts=8:sw=4:sts=4:et
a733c37f 2package DBIx::Class::Ordered;
118e6b96 3use strict;
4use warnings;
5use base qw( DBIx::Class );
6
7=head1 NAME
8
a733c37f 9DBIx::Class::Ordered - Modify the position of objects in an ordered list.
118e6b96 10
11=head1 SYNOPSIS
12
a733c37f 13Create a table for your ordered data.
118e6b96 14
a733c37f 15 CREATE TABLE items (
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 22In your Schema or DB class add Ordered to the top
118e6b96 23of the component list.
24
a733c37f 25 __PACKAGE__->load_components(qw( Ordered ... ));
118e6b96 26
27Specify the column that stores the position number for
28each row.
29
a733c37f 30 package My::Item;
118e6b96 31 __PACKAGE__->position_column('position');
a733c37f 32 __PACKAGE__->grouping_column('group_id'); # optional
118e6b96 33
34Thats 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();
44 my @siblings = $item->siblings();
118e6b96 45
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 60This module provides a simple interface for modifying the ordered
61position of DBIx::Class objects.
118e6b96 62
133dd22a 63=head1 AUTO UPDATE
64
65All of the move_* methods automatically update the rows involved in
66the query. This is not configurable and is due to the fact that if you
67move 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
75Sets and retrieves the name of the column that stores the
76positional 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
86This method specified a column to limit all queries in
87this module by. This effectively allows you to have multiple
a733c37f 88ordered lists within the same table.
133dd22a 89
90=cut
91
a733c37f 92__PACKAGE__->mk_classdata( 'grouping_column' );
133dd22a 93
118e6b96 94=head2 siblings
95
a733c37f 96 my $rs = $item->siblings();
97 my @siblings = $item->siblings();
118e6b96 98
99Returns either a result set or an array of all other objects
100excluding the one you called it on.
101
102=cut
103
104sub siblings {
105 my( $self ) = @_;
106 my $position_column = $self->position_column;
a9cdbec2 107 my $rs = $self->result_source->resultset->search(
7a76f44c 108 {
109 $position_column => { '!=' => $self->get_column($position_column) },
a733c37f 110 $self->_grouping_clause(),
7a76f44c 111 },
118e6b96 112 { order_by => $self->position_column },
113 );
7a76f44c 114 return $rs->all() if (wantarray());
115 return $rs;
118e6b96 116}
117
118=head2 first_sibling
119
a733c37f 120 my $sibling = $item->first_sibling();
118e6b96 121
5faa95af 122Returns the first sibling object, or 0 if the first sibling
123is this sibliing.
118e6b96 124
125=cut
126
127sub 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 142Return the last sibling, or 0 if the last sibling is this
143sibling.
118e6b96 144
145=cut
146
147sub 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 163Returns the sibling that resides one position back. Undef
118e6b96 164is returned if the current object is the first one.
165
166=cut
167
168sub previous_sibling {
169 my( $self ) = @_;
170 my $position_column = $self->position_column;
707cbb2d 171 my $position = $self->get_column( $position_column );
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 185Returns the sibling that resides one position foward. Undef
118e6b96 186is returned if the current object is the last one.
187
188=cut
189
190sub 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 208Swaps position with the sibling on position previous in the list.
2091 is returned on success, and 0 is returned if the objects is already
210the first one.
118e6b96 211
212=cut
213
80010e2b 214sub move_previous {
118e6b96 215 my( $self ) = @_;
133dd22a 216 my $position = $self->get_column( $self->position_column() );
217 return $self->move_to( $position - 1 );
118e6b96 218}
219
80010e2b 220=head2 move_next
118e6b96 221
a733c37f 222 $item->move_next();
118e6b96 223
80010e2b 224Swaps position with the sibling in the next position. 1 is returned on
225success, and 0 is returned if the object is already the last in the list.
118e6b96 226
227=cut
228
80010e2b 229sub 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);
234 return $self->move_to( $position + 1 );
118e6b96 235}
236
237=head2 move_first
238
a733c37f 239 $item->move_first();
118e6b96 240
241Moves the object to the first position. 1 is returned on
242success, and 0 is returned if the object is already the first.
243
244=cut
245
246sub 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
255Moves the object to the very last position. 1 is returned on
256success, and 0 is returned if the object is already the last one.
257
258=cut
259
260sub 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
270Moves the object to the specified position. 1 is returned on
271success, and 0 is returned if the object is already at the
272specified position.
273
274=cut
275
276sub 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 );
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 });
291 my $op = ($from_position>$to_position) ? '+' : '-';
b1c66eea 292 $rs->update({ $position_column => \"$position_column $op 1" });
293 $self->update({ $position_column => $to_position });
118e6b96 294 return 1;
295}
296
297=head2 insert
298
299Overrides the DBIC insert() method by providing a default
300position number. The default will be the number of rows in
301the table +1, thus positioning the new record at the last position.
302
303=cut
304
305sub insert {
306 my $self = shift;
307 my $position_column = $self->position_column;
a733c37f 308 $self->set_column( $position_column => $self->result_source->resultset->search( {$self->_grouping_clause()} )->count()+1 )
118e6b96 309 if (!$self->get_column($position_column));
0a298c73 310 return $self->next::method( @_ );
118e6b96 311}
312
313=head2 delete
314
315Overrides the DBIC delete() method by first moving the object
316to the last position, then deleting it, thus ensuring the
317integrity of the positions.
318
319=cut
320
321sub delete {
322 my $self = shift;
323 $self->move_last;
0a298c73 324 return $self->next::method( @_ );
118e6b96 325}
326
7a76f44c 327=head1 PRIVATE METHODS
328
329These methods are used internally. You should never have the
330need to use them.
331
a733c37f 332=head2 _grouping_clause
118e6b96 333
133dd22a 334This method returns a name=>value pare for limiting a search
335by the collection column. If the collection column is not
336defined then this will return an empty list.
118e6b96 337
7a76f44c 338=cut
339
a733c37f 340sub _grouping_clause {
169bb185 341 my( $self ) = @_;
a733c37f 342 my $col = $self->grouping_column();
343 if ($col) {
344 return ( $col => $self->get_column($col) );
133dd22a 345 }
7a76f44c 346 return ();
347}
348
3491;
350__END__
118e6b96 351
352=head1 BUGS
353
dc66dea1 354=head2 Unique Constraints
355
356Unique indexes and constraints on the position column are not
357supported at this time. It would be make sense to support them,
358but there are some unexpected database issues that make this
359hard to do. The main problem from the author's view is that
360SQLite (the DB engine that we use for testing) does not support
361ORDER BY on updates.
362
133dd22a 363=head2 Race Condition on Insert
364
118e6b96 365If a position is not specified for an insert than a position
366will be chosen based on COUNT(*)+1. But, it first selects the
367count then inserts the record. The space of time between select
368and insert introduces a race condition. To fix this we need the
369ability to lock tables in DBIC. I've added an entry in the TODO
370about this.
371
133dd22a 372=head2 Multiple Moves
373
374Be careful when issueing move_* methods to multiple objects. If
375you've pre-loaded the objects then when you move one of the objects
376the position of the other object will not reflect their new value
377until you reload them from the database.
378
dc66dea1 379There are times when you will want to move objects as groups, such
133dd22a 380as changeing the parent of several objects at once - this directly
381conflicts with this problem. One solution is for us to write a
382ResultSet class that supports a parent() method, for example. Another
383solution is to somehow automagically modify the objects that exist
384in the current object's result set to have the new position value.
385
118e6b96 386=head1 AUTHOR
387
388Aran Deltac <bluefeet@cpan.org>
389
390=head1 LICENSE
391
392You may distribute this code under the same terms as Perl itself.
393