resultset_class/result_class now (again) auto loads the specified class; requires...
[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 );
1d941d67 20
e9188247 21Optionally, add one or more columns to specify groupings, allowing you
22to maintain independent ordered lists within one table:
23
24 CREATE TABLE items (
25 item_id INTEGER PRIMARY KEY AUTOINCREMENT,
26 name TEXT NOT NULL,
27 position INTEGER NOT NULL,
28 group_id INTEGER NOT NULL
29 );
30
31Or even
32
33 CREATE TABLE items (
34 item_id INTEGER PRIMARY KEY AUTOINCREMENT,
35 name TEXT NOT NULL,
36 position INTEGER NOT NULL,
37 group_id INTEGER NOT NULL,
38 other_group_id INTEGER NOT NULL
39 );
40
a8492531 41In your Schema or DB class add "Ordered" to the top
118e6b96 42of the component list.
43
a733c37f 44 __PACKAGE__->load_components(qw( Ordered ... ));
118e6b96 45
46Specify the column that stores the position number for
47each row.
48
a733c37f 49 package My::Item;
118e6b96 50 __PACKAGE__->position_column('position');
1d941d67 51
e9188247 52If you are using one grouping column, specify it as follows:
53
54 __PACKAGE__->grouping_column('group_id');
55
56Or if you have multiple grouping columns:
57
58 __PACKAGE__->grouping_column(['group_id', 'other_group_id']);
59
a8492531 60That's it, now you can change the position of your objects.
118e6b96 61
62 #!/use/bin/perl
a733c37f 63 use My::Item;
118e6b96 64
a733c37f 65 my $item = My::Item->create({ name=>'Matt S. Trout' });
66 # If using grouping_column:
67 my $item = My::Item->create({ name=>'Matt S. Trout', group_id=>1 });
118e6b96 68
a733c37f 69 my $rs = $item->siblings();
70 my @siblings = $item->siblings();
118e6b96 71
72 my $sibling;
a733c37f 73 $sibling = $item->first_sibling();
74 $sibling = $item->last_sibling();
75 $sibling = $item->previous_sibling();
76 $sibling = $item->next_sibling();
118e6b96 77
a733c37f 78 $item->move_previous();
79 $item->move_next();
80 $item->move_first();
81 $item->move_last();
82 $item->move_to( $position );
1d941d67 83 $item->move_to_group( 'groupname' );
84 $item->move_to_group( 'groupname', $position );
85 $item->move_to_group( {group_id=>'groupname', 'other_group_id=>'othergroupname'} );
86 $item->move_to_group( {group_id=>'groupname', 'other_group_id=>'othergroupname'}, $position );
118e6b96 87
88=head1 DESCRIPTION
89
a733c37f 90This module provides a simple interface for modifying the ordered
91position of DBIx::Class objects.
118e6b96 92
133dd22a 93=head1 AUTO UPDATE
94
95All of the move_* methods automatically update the rows involved in
96the query. This is not configurable and is due to the fact that if you
97move a record it always causes other records in the list to be updated.
98
118e6b96 99=head1 METHODS
100
101=head2 position_column
102
103 __PACKAGE__->position_column('position');
104
105Sets and retrieves the name of the column that stores the
a8492531 106positional value of each record. Defaults to "position".
118e6b96 107
108=cut
109
110__PACKAGE__->mk_classdata( 'position_column' => 'position' );
111
a733c37f 112=head2 grouping_column
133dd22a 113
a733c37f 114 __PACKAGE__->grouping_column('group_id');
133dd22a 115
a8492531 116This method specifies a column to limit all queries in
133dd22a 117this module by. This effectively allows you to have multiple
a733c37f 118ordered lists within the same table.
133dd22a 119
120=cut
121
a733c37f 122__PACKAGE__->mk_classdata( 'grouping_column' );
133dd22a 123
118e6b96 124=head2 siblings
125
a733c37f 126 my $rs = $item->siblings();
127 my @siblings = $item->siblings();
118e6b96 128
a8492531 129Returns either a resultset or an array of all other objects
118e6b96 130excluding the one you called it on.
131
132=cut
133
134sub siblings {
135 my( $self ) = @_;
136 my $position_column = $self->position_column;
a9cdbec2 137 my $rs = $self->result_source->resultset->search(
7a76f44c 138 {
139 $position_column => { '!=' => $self->get_column($position_column) },
a733c37f 140 $self->_grouping_clause(),
7a76f44c 141 },
118e6b96 142 { order_by => $self->position_column },
143 );
7a76f44c 144 return $rs->all() if (wantarray());
145 return $rs;
118e6b96 146}
147
148=head2 first_sibling
149
a733c37f 150 my $sibling = $item->first_sibling();
118e6b96 151
5faa95af 152Returns the first sibling object, or 0 if the first sibling
a8492531 153is this sibling.
118e6b96 154
155=cut
156
157sub first_sibling {
158 my( $self ) = @_;
5faa95af 159 return 0 if ($self->get_column($self->position_column())==1);
fa6b598f 160
a9cdbec2 161 return ($self->result_source->resultset->search(
162 {
163 $self->position_column => 1,
a733c37f 164 $self->_grouping_clause(),
a9cdbec2 165 },
118e6b96 166 )->all())[0];
167}
168
169=head2 last_sibling
170
a733c37f 171 my $sibling = $item->last_sibling();
118e6b96 172
a8492531 173Returns the last sibling, or 0 if the last sibling is this
5faa95af 174sibling.
118e6b96 175
176=cut
177
178sub last_sibling {
179 my( $self ) = @_;
a733c37f 180 my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
5faa95af 181 return 0 if ($self->get_column($self->position_column())==$count);
a9cdbec2 182 return ($self->result_source->resultset->search(
183 {
184 $self->position_column => $count,
a733c37f 185 $self->_grouping_clause(),
a9cdbec2 186 },
118e6b96 187 )->all())[0];
188}
189
190=head2 previous_sibling
191
a733c37f 192 my $sibling = $item->previous_sibling();
118e6b96 193
a8492531 194Returns the sibling that resides one position back. Returns undef
195if the current object is the first one.
118e6b96 196
197=cut
198
199sub previous_sibling {
200 my( $self ) = @_;
201 my $position_column = $self->position_column;
707cbb2d 202 my $position = $self->get_column( $position_column );
203 return 0 if ($position==1);
3ffca97b 204 return ($self->result_source->resultset->search(
7a76f44c 205 {
707cbb2d 206 $position_column => $position - 1,
a733c37f 207 $self->_grouping_clause(),
707cbb2d 208 }
118e6b96 209 )->all())[0];
210}
211
212=head2 next_sibling
213
a733c37f 214 my $sibling = $item->next_sibling();
118e6b96 215
a8492531 216Returns the sibling that resides one position forward. Returns undef
217if the current object is the last one.
118e6b96 218
219=cut
220
221sub next_sibling {
222 my( $self ) = @_;
223 my $position_column = $self->position_column;
707cbb2d 224 my $position = $self->get_column( $position_column );
a733c37f 225 my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
707cbb2d 226 return 0 if ($position==$count);
133dd22a 227 return ($self->result_source->resultset->search(
7a76f44c 228 {
707cbb2d 229 $position_column => $position + 1,
a733c37f 230 $self->_grouping_clause(),
7a76f44c 231 },
118e6b96 232 )->all())[0];
233}
234
80010e2b 235=head2 move_previous
118e6b96 236
a733c37f 237 $item->move_previous();
118e6b96 238
a8492531 239Swaps position with the sibling in the position previous in
240the list. Returns 1 on success, and 0 if the object is
241already the first one.
118e6b96 242
243=cut
244
80010e2b 245sub move_previous {
118e6b96 246 my( $self ) = @_;
133dd22a 247 my $position = $self->get_column( $self->position_column() );
248 return $self->move_to( $position - 1 );
118e6b96 249}
250
80010e2b 251=head2 move_next
118e6b96 252
a733c37f 253 $item->move_next();
118e6b96 254
a8492531 255Swaps position with the sibling in the next position in the
256list. Returns 1 on success, and 0 if the object is already
257the last in the list.
118e6b96 258
259=cut
260
80010e2b 261sub move_next {
118e6b96 262 my( $self ) = @_;
133dd22a 263 my $position = $self->get_column( $self->position_column() );
a733c37f 264 my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
133dd22a 265 return 0 if ($position==$count);
266 return $self->move_to( $position + 1 );
118e6b96 267}
268
269=head2 move_first
270
a733c37f 271 $item->move_first();
118e6b96 272
a8492531 273Moves the object to the first position in the list. Returns 1
274on success, and 0 if the object is already the first.
118e6b96 275
276=cut
277
278sub move_first {
279 my( $self ) = @_;
280 return $self->move_to( 1 );
281}
282
283=head2 move_last
284
a733c37f 285 $item->move_last();
118e6b96 286
a8492531 287Moves the object to the last position in the list. Returns 1
288on success, and 0 if the object is already the last one.
118e6b96 289
290=cut
291
292sub move_last {
293 my( $self ) = @_;
a733c37f 294 my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
118e6b96 295 return $self->move_to( $count );
296}
297
298=head2 move_to
299
a733c37f 300 $item->move_to( $position );
118e6b96 301
a8492531 302Moves the object to the specified position. Returns 1 on
303success, and 0 if the object is already at the specified
304position.
118e6b96 305
306=cut
307
308sub move_to {
309 my( $self, $to_position ) = @_;
310 my $position_column = $self->position_column;
311 my $from_position = $self->get_column( $position_column );
133dd22a 312 return 0 if ( $to_position < 1 );
313 return 0 if ( $from_position==$to_position );
dc66dea1 314 my @between = (
315 ( $from_position < $to_position )
316 ? ( $from_position+1, $to_position )
317 : ( $to_position, $from_position-1 )
318 );
133dd22a 319 my $rs = $self->result_source->resultset->search({
dc66dea1 320 $position_column => { -between => [ @between ] },
a733c37f 321 $self->_grouping_clause(),
118e6b96 322 });
323 my $op = ($from_position>$to_position) ? '+' : '-';
fa6b598f 324 $rs->update({ $position_column => \"$position_column $op 1" }); #" Sorry, GEdit bug
79dc353a 325 $self->{_ORDERED_INTERNAL_UPDATE} = 1;
b1c66eea 326 $self->update({ $position_column => $to_position });
118e6b96 327 return 1;
328}
329
fa6b598f 330
331
79dc353a 332=head2 move_to_group
333
334 $item->move_to_group( $group, $position );
335
336Moves the object to the specified position of the specified
337group, or to the end of the group if $position is undef.
3381 is returned on success, and 0 is returned if the object is
339already at the specified position of the specified group.
340
1d941d67 341$group may be specified as a single scalar if only one
342grouping column is in use, or as a hashref of column => value pairs
343if multiple grouping columns are in use.
fa6b598f 344
79dc353a 345=cut
346
347sub move_to_group {
348 my( $self, $to_group, $to_position ) = @_;
fa6b598f 349
350 # if we're given a string, turn it into a hashref
351 unless (ref $to_group eq 'HASH') {
352 $to_group = {($self->_grouping_columns)[0] => $to_group};
353 }
354
79dc353a 355 my $position_column = $self->position_column;
fa6b598f 356 #my @grouping_columns = $self->_grouping_columns;
79dc353a 357
358 return 0 if ( ! defined($to_group) );
359 return 0 if ( defined($to_position) and $to_position < 1 );
fa6b598f 360 return 0 if ( $self->_is_in_group($to_group)
361 and ((not defined($to_position))
362 or (defined($to_position) and $self->$position_column==$to_position)
363 )
364 );
79dc353a 365
366 # Move to end of current group and adjust siblings
367 $self->move_last;
368
fa6b598f 369 $self->set_columns($to_group);
79dc353a 370 my $new_group_count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
371 if (!defined($to_position) or $to_position > $new_group_count) {
372 $self->{_ORDERED_INTERNAL_UPDATE} = 1;
373 $self->update({ $position_column => $new_group_count + 1 });
374 }
375 else {
376 my @between = ($to_position, $new_group_count);
377
378 my $rs = $self->result_source->resultset->search({
379 $position_column => { -between => [ @between ] },
380 $self->_grouping_clause(),
381 });
fa6b598f 382 $rs->update({ $position_column => \"$position_column + 1" }); #"
79dc353a 383 $self->{_ORDERED_INTERNAL_UPDATE} = 1;
384 $self->update({ $position_column => $to_position });
385 }
386
387 return 1;
388}
389
118e6b96 390=head2 insert
391
392Overrides the DBIC insert() method by providing a default
393position number. The default will be the number of rows in
394the table +1, thus positioning the new record at the last position.
395
396=cut
397
398sub insert {
399 my $self = shift;
400 my $position_column = $self->position_column;
a733c37f 401 $self->set_column( $position_column => $self->result_source->resultset->search( {$self->_grouping_clause()} )->count()+1 )
118e6b96 402 if (!$self->get_column($position_column));
0a298c73 403 return $self->next::method( @_ );
118e6b96 404}
405
79dc353a 406=head2 update
407
408Overrides the DBIC update() method by checking for a change
409to the position and/or group columns. Movement within a
410group or to another group is handled by repositioning
411the appropriate siblings. Position defaults to the end
412of a new group if it has been changed to undef.
413
414=cut
415
416sub update {
417 my $self = shift;
418
419 if ($self->{_ORDERED_INTERNAL_UPDATE}) {
420 delete $self->{_ORDERED_INTERNAL_UPDATE};
421 return $self->next::method( @_ );
422 }
423
424 $self->set_columns($_[0]) if @_ > 0;
425 my %changes = $self->get_dirty_columns;
426 $self->discard_changes;
427
428 my $pos_col = $self->position_column;
fa6b598f 429
fa6b598f 430 # if any of our grouping columns have been changed
fa6b598f 431 if (grep {$_} map {exists $changes{$_}} $self->_grouping_columns ) {
432
433 # create new_group by taking the current group and inserting changes
434 my $new_group = {$self->_grouping_clause};
435 foreach my $col (keys %$new_group) {
436 if (exists $changes{$col}) {
437 $new_group->{$col} = $changes{$col};
438 delete $changes{$col}; # don't want to pass this on to next::method
439 }
440 }
441
79dc353a 442 $self->move_to_group(
fa6b598f 443 $new_group,
79dc353a 444 exists($changes{$pos_col}) ? delete($changes{$pos_col}) : $self->$pos_col
445 );
446 }
447 elsif (exists $changes{$pos_col}) {
448 $self->move_to(delete $changes{$pos_col});
449 }
450 return $self->next::method( \%changes );
451}
452
118e6b96 453=head2 delete
454
455Overrides the DBIC delete() method by first moving the object
456to the last position, then deleting it, thus ensuring the
457integrity of the positions.
458
459=cut
460
461sub delete {
462 my $self = shift;
463 $self->move_last;
0a298c73 464 return $self->next::method( @_ );
118e6b96 465}
466
7a76f44c 467=head1 PRIVATE METHODS
468
469These methods are used internally. You should never have the
470need to use them.
471
a733c37f 472=head2 _grouping_clause
118e6b96 473
e9188247 474This method returns one or more name=>value pairs for limiting a search
475by the grouping column(s). If the grouping column is not
133dd22a 476defined then this will return an empty list.
118e6b96 477
7a76f44c 478=cut
a733c37f 479sub _grouping_clause {
169bb185 480 my( $self ) = @_;
fa6b598f 481 return map { $_ => $self->get_column($_) } $self->_grouping_columns();
482}
483
484
485
486=head2 _get_grouping_columns
487
488Returns a list of the column names used for grouping, regardless of whether
1d941d67 489they were specified as an arrayref or a single string, and returns ()
490if there is no grouping.
fa6b598f 491
492=cut
493sub _grouping_columns {
494 my( $self ) = @_;
a733c37f 495 my $col = $self->grouping_column();
fa6b598f 496 if (ref $col eq 'ARRAY') {
497 return @$col;
498 } elsif ($col) {
499 return ( $col );
500 } else {
501 return ();
133dd22a 502 }
7a76f44c 503}
504
fa6b598f 505
506
507=head2 _is_in_group($other)
508
509 $item->_is_in_group( {user => 'fred', list => 'work'} )
510
511Returns true if the object is in the group represented by hashref $other
512=cut
513sub _is_in_group {
514 my ($self, $other) = @_;
515 my $current = {$self->_grouping_clause};
516 return 0 unless (ref $other eq 'HASH') and (keys %$current == keys %$other);
517 for my $key (keys %$current) {
518 return 0 unless exists $other->{$key};
519 return 0 if $current->{$key} ne $other->{$key};
520 }
521 return 1;
522}
523
524
7a76f44c 5251;
526__END__
118e6b96 527
528=head1 BUGS
529
dc66dea1 530=head2 Unique Constraints
531
532Unique indexes and constraints on the position column are not
533supported at this time. It would be make sense to support them,
534but there are some unexpected database issues that make this
535hard to do. The main problem from the author's view is that
536SQLite (the DB engine that we use for testing) does not support
537ORDER BY on updates.
538
133dd22a 539=head2 Race Condition on Insert
540
118e6b96 541If a position is not specified for an insert than a position
542will be chosen based on COUNT(*)+1. But, it first selects the
a8492531 543count, and then inserts the record. The space of time between select
118e6b96 544and insert introduces a race condition. To fix this we need the
545ability to lock tables in DBIC. I've added an entry in the TODO
546about this.
547
133dd22a 548=head2 Multiple Moves
549
550Be careful when issueing move_* methods to multiple objects. If
551you've pre-loaded the objects then when you move one of the objects
552the position of the other object will not reflect their new value
553until you reload them from the database.
554
dc66dea1 555There are times when you will want to move objects as groups, such
133dd22a 556as changeing the parent of several objects at once - this directly
557conflicts with this problem. One solution is for us to write a
558ResultSet class that supports a parent() method, for example. Another
559solution is to somehow automagically modify the objects that exist
560in the current object's result set to have the new position value.
561
118e6b96 562=head1 AUTHOR
563
564Aran Deltac <bluefeet@cpan.org>
565
566=head1 LICENSE
567
568You may distribute this code under the same terms as Perl itself.
569