Tests for adjacency list as well as a bunch of fixes.

[dbsrgits/DBIx-Class-Tree.git] / lib / DBIx / Class / Tree / AdjacencyList.pm

diff --git a/lib/DBIx/Class/Tree/AdjacencyList.pm b/lib/DBIx/Class/Tree/AdjacencyList.pm
index d1ef803..99f32ad 100644 (file)
--- a/lib/DBIx/Class/Tree/AdjacencyList.pm
+++ b/lib/DBIx/Class/Tree/AdjacencyList.pm
@@ -15,7 +15,7 @@ Create a table for your tree data.
 
   CREATE TABLE employees (
     employee_id INTEGER PRIMARY KEY AUTOINCREMENT,
-    parent_id INTEGER NOT NULL,
+    parent_id INTEGER NOT NULL DEFAULT 0,
     name TEXT NOT NULL
   );
 
@@ -31,7 +31,7 @@ Specify the column that contains the parent ID of each row.
 
 Thats it, now you can modify and analyze the tree.
 
-  #!/use/bin/perl
+  #!/usr/bin/perl
   use My::Employee;
   
   my $employee = My::Employee->create({ name=>'Matt S. Trout' });
@@ -59,11 +59,26 @@ other rows.
   __PACKAGE__->parent_column('parent_id');
 
 Declares the name of the column that contains the self-referential 
-ID which defines the parent row.  Defaults to "parent_id".
+ID which defines the parent row.  Defaults to "parent_id".  This 
+will create a has_many (children) and belongs_to (parent) 
+relationship.
 
 =cut
 
-__PACKAGE__->mk_classdata( 'parent_column' => 'parent_id' );
+__PACKAGE__->mk_classdata( '_parent_column' => 'parent_id' );
+
+sub parent_column {
+    my $class = shift;
+    if (@_) {
+        my $parent_col = shift;
+        my $primary_col = ($class->primary_columns())[0];
+        $class->belongs_to( '_parent' => $class => { "foreign.$primary_col" => "self.$parent_col" } );
+        $class->has_many( 'children' => $class => { "foreign.$parent_col" => "self.$primary_col" } );
+        $class->_parent_column( $parent_col );
+        return 1;
+    }
+    return $class->_parent_column();
+}
 
 =head2 parent
 
@@ -71,28 +86,25 @@ __PACKAGE__->mk_classdata( 'parent_column' => 'parent_id' );
   $employee->parent( $parent_obj );
   $employee->parent( $parent_id );
 
-Retrieves the object's parent ID, or sets the object's 
-parent ID.  If setting the parent ID then 0 will be returned 
-if the object already has the specified parent, and 1 on 
-success.
+Retrieves the object's parent object, or changes the object's 
+parent to the specified parent or parent ID.
 
 =cut
 
 sub parent {
-    my( $self, $new_parent ) = @_;
-    my $parent_column = $self->parent_column();
-    if ($new_parent) {
+    my $self = shift;
+    if (@_) {
+        my $new_parent = shift;
+        my $parent_col = $self->_parent_column();
         if (ref($new_parent)) {
-            $new_parent = $new_parent->id() || 0;
+            $new_parent = $new_parent->id() || croak('Parent object does not have an ID');;
         }
-        return 0 if ($new_parent == ($self->get_column($parent_column)||0));
-        $self->set_column( $parent_column => $new_parent );
+        return 0 if ($new_parent == ($self->get_column($parent_col)||0));
+        $self->set_column( $parent_col => $new_parent );
         $self->update();
         return 1;
     }
-    else {
-        return $self->find( $self->get_column( $parent_column ) );
-    }
+    return $self->_parent();
 }
 
 =head2 children
@@ -101,32 +113,49 @@ sub parent {
   my @children = $employee->children();
 
 Returns a list or record set, depending on context, of all 
-the objects one level below the current one.
-
-=cut
-
-sub children {
-    my( $self ) = @_;
-    my $rs = $self->result_source->resultset->search(
-        { $self->parent_column()=>$self->id() }
-    );
-    return $rs->all() if (wantarray());
-    return $rs;
-}
+the objects one level below the current one.  This method 
+is created when parent_column() is called, which sets up a 
+has_many relationship called children.
 
 =head2 attach_child
 
   $parent->attach_child( $child );
 
-Sets (or moves) the child to the new parent.
+Sets the child to the new parent.
 
 =cut
 
 sub attach_child {
     my( $self, $child ) = @_;
-    $child->parent( $self );
+    return $child->parent( $self );
 }
 
+=head2 siblings
+
+  my $rs = $node->siblings();
+  my @siblings = $node->siblings();
+
+Returns either a result set or an array of all other objects 
+with the same parent as the calling object.
+
+=cut
+
+sub siblings {
+    my( $self ) = @_;
+    my $parent_col = $self->_parent_column;
+    my $primary_col = ($self->primary_columns())[0];
+    my $rs = $self->result_source->resultset->search(
+        {
+            $parent_col => $self->get_column($parent_col),
+            $primary_col => { '!=' => $self->get_column($primary_col) },
+        },
+    );
+    return $rs->all() if (wantarray());
+    return $rs;
+}
+
+=cut
+
 =head2 attach_sibling
 
   $this->attach_sibling( $that );
@@ -137,8 +166,8 @@ as the calling object.
 =cut
 
 sub attach_sibling {
-    my( $self, $child ) = @_;
-    $child->parent( $self->parent() );
+    my( $self, $node ) = @_;
+    return $node->parent( $self->parent() );
 }
 
 1;