From: Aran Deltac Date: Sun, 19 Mar 2006 03:27:48 +0000 (+0000) Subject: Adding a new component for handling positioned lists. X-Git-Tag: v0.07002~75^2~297 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=118e6b9689aa2bb62be36e7770984aae8aea1834;p=dbsrgits%2FDBIx-Class.git Adding a new component for handling positioned lists. --- diff --git a/lib/DBIx/Class/Positioned.pm b/lib/DBIx/Class/Positioned.pm new file mode 100644 index 0000000..d11c711 --- /dev/null +++ b/lib/DBIx/Class/Positioned.pm @@ -0,0 +1,318 @@ +# vim: ts=8:sw=4:sts=4:et +package DBIx::Class::Positioned; +use strict; +use warnings; +use base qw( DBIx::Class ); + +=head1 NAME + +DBIx::Class::Positioned - Modify the position of objects in an ordered list. + +=head1 SYNOPSIS + +Create a table for your positionable data. + + CREATE TABLE employees ( + employee_id INTEGER PRIMARY KEY AUTOINCREMENT, + name TEXT NOT NULL, + position INTEGER NOT NULL + ); + +In your Schema or DB class add Positioned to the top +of the component list. + + __PACKAGE__->load_components(qw( Positioned ... )); + +Specify the column that stores the position number for +each row. + + package My::Employee; + __PACKAGE__->position_column('position'); + +Thats it, now you can change the position of your objects. + + #!/use/bin/perl + use My::Employee; + + my $employee = My::Employee->create({ name=>'Matt S. Trout' }); + + my $rs = $employee->siblings(); + my @siblings = $employee->siblings(); + + my $sibling; + $sibling = $employee->first_sibling(); + $sibling = $employee->last_sibling(); + $sibling = $employee->previous_sibling(); + $sibling = $employee->next_sibling(); + + $employee->move_previous(); + $employee->move_next(); + $employee->move_first(); + $employee->move_last(); + $employee->move_to( $position ); + +=head1 DESCRIPTION + +This module provides a simple interface for modifying the position +of DBIx::Class objects. + +=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 siblings + + my $rs = $employee->siblings(); + my @siblings = $employee->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->search( + { $position_column => { '!=' => $self->get_column($position_column) } }, + { order_by => $self->position_column }, + ); + if (wantarray()) { return $rs->all(); } + else { return $rs; } +} + +=head2 first_sibling + + my $sibling = $employee->first_sibling(); + +Returns the first sibling object. + +=cut + +sub first_sibling { + my( $self ) = @_; + return ($self->search( + {}, + { rows=>1, order_by => $self->position_column }, + )->all())[0]; +} + +=head2 last_sibling + + my $sibling = $employee->last_sibling(); + +Return the last sibling. + +=cut + +sub last_sibling { + my( $self ) = @_; + return ($self->search( + {}, + { rows=>1, order_by => $self->position_column.' DESC' }, + )->all())[0]; +} + +=head2 previous_sibling + + my $sibling = $employee->previous_sibling(); + +Returns the sibling that resides one position higher. Undef +is returned if the current object is the first one. + +=cut + +sub previous_sibling { + my( $self ) = @_; + my $position_column = $self->position_column; + return ($self->search( + { $position_column => { '<' => $self->get_column($position_column) } }, + { rows=>1, order_by => $position_column.' DESC' }, + )->all())[0]; +} + +=head2 next_sibling + + my $sibling = $employee->next_sibling(); + +Returns the sibling that resides one position lower. Undef +is returned if the current object is the last one. + +=cut + +sub next_sibling { + my( $self ) = @_; + my $position_column = $self->position_column; + return ($self->search( + { $position_column => { '>' => $self->get_column($position_column) } }, + { rows=>1, order_by => $position_column }, + )->all())[0]; +} + +=head2 move_up + + $employee->move_up(); + +Swaps position with the sibling on position higher. 1 is returned on +success, and 0 is returned if the objects is already the first one. + +=cut + +sub move_up { + my( $self ) = @_; + my $previous = $self->previous_sibling(); + return undef if (!$previous); + my $position_column = $self->position_column; + my $self_position = $self->get_column( $position_column ); + $self->set_column( $position_column, $previous->get_column($position_column) ); + $previous->set_column( $position_column, $self_position ); + $self->update(); + $previous->update(); + return 1; +} + +=head2 move_down + + $employee->move_down(); + +Swaps position with the sibling on position lower. 1 is returned on +success, and 0 is returned if the object is already at the last position. + +=cut + +sub move_down { + my( $self ) = @_; + my $next = $self->next_sibling(); + return undef if (!$next); + my $position_column = $self->position_column; + my $self_position = $self->get_column( $position_column ); + $self->set_column( $position_column, $next->get_column($position_column) ); + $next->set_column( $position_column, $self_position ); + $self->update(); + $next->update(); + return 1; +} + +=head2 move_first + + $employee->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 + + $employee->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->search()->count(); + return $self->move_to( $count ); +} + +=head2 move_to + + $employee->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 undef if ( $from_position==$to_position ); + my $rs = $self->search({ + -and => [ + $position_column => { ($from_position>$to_position?'<':'>') => $from_position }, + $position_column => { ($from_position>$to_position?'>=':'<=') => $to_position }, + ] + }); + my $op = ($from_position>$to_position) ? '+' : '-'; + $rs->update({ + $position_column => \"$position_column $op 1", + }); + $self->set_column( $position_column => $to_position ); + $self->update(); + 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->count()+1 ) + if (!$self->get_column($position_column)); + $self->next::method( @_ ); +} + +=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; + $self->next::method( @_ ); +} + +1; +__END__ + +=head1 TODO + +Support foreign keys that cause rows to be members of mini +positionable sets. + +=head1 BUGS + +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. + +=head1 AUTHOR + +Aran Deltac + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. +