Fixes to Tree::AdjacencyList, and working tests.
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Positioned.pm
index 35db710..5266f9d 100644 (file)
@@ -17,6 +17,7 @@ Create a table for your positionable data.
     name TEXT NOT NULL,
     position INTEGER NOT NULL
   );
+  # Optional: group_id INTEGER NOT NULL
 
 In your Schema or DB class add Positioned to the top 
 of the component list.
@@ -28,6 +29,7 @@ each row.
 
   package My::Employee;
   __PACKAGE__->position_column('position');
+  __PACKAGE__->collection_column('group_id'); # optional
 
 Thats it, now you can change the position of your objects.
 
@@ -35,6 +37,8 @@ Thats it, now you can change the position of your objects.
   use My::Employee;
   
   my $employee = My::Employee->create({ name=>'Matt S. Trout' });
+  # If using collection_column:
+  my $employee = My::Employee->create({ name=>'Matt S. Trout', group_id=>1 });
   
   my $rs = $employee->siblings();
   my @siblings = $employee->siblings();
@@ -56,6 +60,12 @@ Thats it, now you can change the position of your objects.
 This module provides a simple interface for modifying the 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
@@ -69,6 +79,18 @@ positional value of each record.  Default to "position".
 
 __PACKAGE__->mk_classdata( 'position_column' => 'position' );
 
+=head2 collection_column
+
+  __PACKAGE__->collection_column('thing_id');
+
+This method specified a column to limit all queries in 
+this module by.  This effectively allows you to have multiple 
+positioned lists within the same table.
+
+=cut
+
+__PACKAGE__->mk_classdata( 'collection_column' );
+
 =head2 siblings
 
   my $rs = $employee->siblings();
@@ -82,27 +104,34 @@ excluding the one you called it on.
 sub siblings {
     my( $self ) = @_;
     my $position_column = $self->position_column;
-    my $rs = $self->search(
-        { $position_column => { '!=' => $self->get_column($position_column) } },
+    my $rs = $self->result_source->resultset->search(
+        {
+            $position_column => { '!=' => $self->get_column($position_column) },
+            $self->_collection_clause(),
+        },
         { order_by => $self->position_column },
     );
-    if (wantarray()) { return $rs->all(); }
-    else { return $rs; }
+    return $rs->all() if (wantarray());
+    return $rs;
 }
 
 =head2 first_sibling
 
   my $sibling = $employee->first_sibling();
 
-Returns the first sibling object.
+Returns the first sibling object, or 0 if the first sibling 
+is this sibliing.
 
 =cut
 
 sub first_sibling {
     my( $self ) = @_;
-    return ($self->search(
-        {},
-        { rows=>1, order_by => $self->position_column },
+    return 0 if ($self->get_column($self->position_column())==1);
+    return ($self->result_source->resultset->search(
+        {
+            $self->position_column => 1,
+            $self->_collection_clause(),
+        },
     )->all())[0];
 }
 
@@ -110,15 +139,20 @@ sub first_sibling {
 
   my $sibling = $employee->last_sibling();
 
-Return the last sibling.
+Return the last sibling, or 0 if the last sibling is this 
+sibling.
 
 =cut
 
 sub last_sibling {
     my( $self ) = @_;
-    return ($self->search(
-        {},
-        { rows=>1, order_by => $self->position_column.' DESC' },
+    my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
+    return 0 if ($self->get_column($self->position_column())==$count);
+    return ($self->result_source->resultset->search(
+        {
+            $self->position_column => $count,
+            $self->_collection_clause(),
+        },
     )->all())[0];
 }
 
@@ -134,9 +168,13 @@ is returned if the current object is the first one.
 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' },
+    my $position = $self->get_column( $position_column );
+    return 0 if ($position==1);
+    return ($self->result_source->resultset->search(
+        {
+            $position_column => $position - 1,
+            $self->_collection_clause(),
+        }
     )->all())[0];
 }
 
@@ -152,9 +190,14 @@ is returned if the current object is the last one.
 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 },
+    my $position = $self->get_column( $position_column );
+    my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
+    return 0 if ($position==$count);
+    return ($self->result_source->resultset->search(
+        {
+            $position_column => $position + 1,
+            $self->_collection_clause(),
+        },
     )->all())[0];
 }
 
@@ -170,15 +213,8 @@ the first one.
 
 sub move_previous {
     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;
+    my $position = $self->get_column( $self->position_column() );
+    return $self->move_to( $position - 1 );
 }
 
 =head2 move_next
@@ -192,15 +228,10 @@ success, and 0 is returned if the object is already the last in the list.
 
 sub move_next {
     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;
+    my $position = $self->get_column( $self->position_column() );
+    my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
+    return 0 if ($position==$count);
+    return $self->move_to( $position + 1 );
 }
 
 =head2 move_first
@@ -228,7 +259,7 @@ success, and 0 is returned if the object is already the last one.
 
 sub move_last {
     my( $self ) = @_;
-    my $count = $self->search()->count();
+    my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
     return $self->move_to( $count );
 }
 
@@ -246,12 +277,14 @@ 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({
+    return 0 if ( $to_position < 1 );
+    return 0 if ( $from_position==$to_position );
+    my $rs = $self->result_source->resultset->search({
         -and => [
             $position_column => { ($from_position>$to_position?'<':'>') => $from_position },
             $position_column => { ($from_position>$to_position?'>=':'<=') => $to_position },
-        ]
+        ],
+        $self->_collection_clause(),
     });
     my $op = ($from_position>$to_position) ? '+' : '-';
     $rs->update({
@@ -273,9 +306,9 @@ the table +1, thus positioning the new record at the last position.
 sub insert {
     my $self = shift;
     my $position_column = $self->position_column;
-    $self->set_column( $position_column => $self->count()+1 ) 
+    $self->set_column( $position_column => $self->result_source->resultset->search( {$self->_collection_clause()} )->count()+1 ) 
         if (!$self->get_column($position_column));
-    $self->next::method( @_ );
+    return $self->next::method( @_ );
 }
 
 =head2 delete
@@ -289,19 +322,37 @@ integrity of the positions.
 sub delete {
     my $self = shift;
     $self->move_last;
-    $self->next::method( @_ );
+    return $self->next::method( @_ );
 }
 
-1;
-__END__
+=head1 PRIVATE METHODS
+
+These methods are used internally.  You should never have the 
+need to use them.
+
+=head2 _collection_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.
 
-=head1 TODO
+=cut
+
+sub _collection_clause {
+    my( $self ) = @_;
+    if ($self->collection_column()) {
+        return ( $self->collection_column() => $self->get_column($self->collection_column()) );
+    }
+    return ();
+}
 
-Support foreign keys that cause rows to be members of mini 
-positionable sets.
+1;
+__END__
 
 =head1 BUGS
 
+=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 
@@ -309,6 +360,20 @@ 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.
+
+The 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>