Migration finished

[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 4c9a758..025ebfb 100644 (file)
--- a/lib/DBIx/Class/Tree/AdjacencyList.pm
+++ b/lib/DBIx/Class/Tree/AdjacencyList.pm
@@ -9,7 +9,7 @@ use Carp qw( croak );
 
 =head1 NAME
 
-DBIx::Class::Tree::AdjacencyList - Manage a tree of data using the common adjacency list model. (EXPERIMENTAL)
+DBIx::Class::Tree::AdjacencyList - Manage a tree of data using the common adjacency list model.
 
 =head1 SYNOPSIS
 
@@ -31,6 +31,10 @@ Specify the column that contains the parent ID of each row.
   package My::Employee;
   __PACKAGE__->parent_column('parent_id');
 
+Optionally, automatically maintane a consistent tree structure.
+
+  __PACKAGE__->repair_tree( 1 );
+
 Thats it, now you can modify and analyze the tree.
 
   #!/usr/bin/perl
@@ -81,13 +85,49 @@ sub parent_column {
         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->has_many( 'parents' => $class => { "foreign.$primary_col" => "self.$parent_col" } );
+        $class->has_many( 'parents' => $class => { "foreign.$primary_col" => "self.$parent_col" }, { cascade_delete => 0 } );
         $class->_parent_column( $parent_col );
         return 1;
     }
     return $class->_parent_column();
 }
 
+=head2 repair_tree
+
+  __PACKAGE__->repair_tree( 1 );
+
+When set a true value this flag causes all changes to a node's parent to
+trigger an integrity check on the tree.  If, when changing a node's parent
+to one of it's descendents then all its children will first be moved to have
+the same current parent, and then the node's parent is changed.
+
+So, for example, if the tree is like this:
+
+  A
+    B
+      C
+      D
+        E
+    F
+
+And you execute:
+
+  $b->parent( $d );
+
+Since D is a descendant of B then all of B's siblings get their parent
+changed to A.  Then B's parent is set to D.
+
+  A
+    C
+    D
+      B
+      E
+    F
+
+=cut
+
+__PACKAGE__->mk_classdata( 'repair_tree' => 0 );
+
 =head2 parent
 
   my $parent = $employee->parent();
@@ -113,6 +153,18 @@ sub parent {
             $new_parent = $new_parent->id() || croak('Parent object does not have an ID');;
         }
         return 0 if ($new_parent == ($self->get_column($parent_col)||0));
+
+        if ($self->repair_tree()) {
+            my $found    = $self->has_descendant( $new_parent );
+            if ($found) {
+                my $children = $self->children();
+
+                while (my $child = $children->next()) {
+                    $child->parent( $self->$parent_col() );
+                }
+            }
+        }
+
         $self->set_column( $parent_col => $new_parent );
         $self->update();
         return 1;
@@ -120,6 +172,29 @@ sub parent {
     return $self->_parent();
 }
 
+=head2 has_descendant
+
+  if ($employee->has_descendant( $id )) { ... }
+
+Returns true if the object has a descendant with the
+specified ID.
+
+=cut
+
+sub has_descendant {
+    my ($self, $find_id) = @_;
+
+    my $children = $self->children();
+    while (my $child = $children->next()) {
+        if ($child->id() eq $find_id) {
+            return 1;
+        }
+        return 1 if ($child->has_descendant( $find_id ));
+    }
+
+    return 0;
+}
+
 =head2 parents
 
   my $parents = $node->parents();
@@ -185,8 +260,6 @@ sub siblings {
     return $rs;
 }
 
-=cut
-
 =head2 attach_sibling
 
   $obj->attach_sibling( $sibling );
@@ -207,6 +280,70 @@ sub attach_sibling {
     return $return;
 }
 
+=head2 is_leaf
+
+  if ($obj->is_leaf()) { ... }
+
+Returns 1 if the object has no children, and 0 otherwise.
+
+=cut
+
+sub is_leaf {
+    my( $self ) = @_;
+
+    my $has_child = $self->result_source->resultset->search(
+        { $self->_parent_column => $self->id() },
+        { limit => 1 }
+    )->count();
+
+    return $has_child ? 0 : 1;
+}
+
+=head2 is_root
+
+  if ($obj->is_root()) { ... }
+
+Returns 1 if the object has no parent, and 0 otherwise.
+
+=cut
+
+sub is_root {
+    my( $self ) = @_;
+    return ( $self->get_column( $self->_parent_column ) ? 0 : 1 );
+}
+
+=head2 is_branch
+
+  if ($obj->is_branch()) { ... }
+
+Returns 1 if the object has a parent and has children.  
+Returns 0 otherwise.
+
+=cut
+
+sub is_branch {
+    my( $self ) = @_;
+    return ( ($self->is_leaf() or $self->is_root()) ? 0 : 1 );
+}
+
+=head2 set_primary_key
+
+This method is an override of DBIx::Class' method for setting the 
+class' primary key column(s).  This method passes control right on 
+to the normal method after first validating that only one column is 
+being selected as a primary key.  If more than one column is then 
+an error will be thrown.
+
+=cut
+
+sub set_primary_key {
+    my $self = shift;
+    if (@_>1) {
+        croak('You may only specify a single column as the primary key for adjacency tree classes');
+    }
+    return $self->next::method( @_ );
+}
+
 1;
 __END__