Improvements to AdjacentList.pm:
[dbsrgits/DBIx-Class-Tree.git] / lib / DBIx / Class / Tree / AdjacencyList.pm
index 58c0961..42fddf3 100644 (file)
@@ -55,8 +55,12 @@ with a parent ID of 0 is the root node and is usually the parent of all
 other rows.  Although, there is no limitation in this module that would 
 stop you from having multiple root nodes.
 
+
+
 =head1 METHODS
 
+
+
 =head2 parent_column
 
   __PACKAGE__->parent_column('parent_id');
@@ -81,13 +85,15 @@ 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 parent
 
   my $parent = $employee->parent();
@@ -120,6 +126,34 @@ sub parent {
     return $self->_parent();
 }
 
+
+
+=head2 set_parent
+
+    $employee->set_parent($boss_obj);
+    $employee->set_parent($boss_id);
+
+A syntactic alternative to ->parent() for setting only.
+
+=cut
+
+sub set_parent {
+    my $self = shift;
+    if (@_) {
+        my $new_parent = shift;
+        my $parent_col = $self->_parent_column();
+        if (ref($new_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));
+        $self->set_column( $parent_col => $new_parent );
+        $self->update();
+        return 1;
+    }
+}
+
+
+
 =head2 parents
 
   my $parents = $node->parents();
@@ -141,10 +175,10 @@ 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
+=head2 add_child
 
-  $parent->attach_child( $child );
-  $parent->attach_child( $child, $child, ... );
+  $parent->add_child( $child );
+  $parent->add_child( $child, $child, ... );
 
 Sets the child, or children, to the new parent.  Returns 1 
 on success and returns 0 if the parent object already has 
@@ -152,7 +186,7 @@ the child.
 
 =cut
 
-sub attach_child {
+sub add_child {
     my $self = shift;
     my $return = 1;
     foreach my $child (@_) {
@@ -161,6 +195,21 @@ sub attach_child {
     return $return;
 }
 
+
+
+=head2 add_children
+
+An alias for add_child.
+
+=cut
+
+sub add_children {
+    my $self = shift;
+    return $self->add_child(@_);
+}
+
+
+
 =head2 siblings
 
   my $rs = $node->siblings();
@@ -185,12 +234,12 @@ sub siblings {
     return $rs;
 }
 
-=cut
 
-=head2 attach_sibling
 
-  $obj->attach_sibling( $sibling );
-  $obj->attach_sibling( $sibling, $sibling, ... );
+=head2 add_sibling
+
+  $obj->add_sibling( $sibling );
+  $obj->add_sibling( $sibling, $sibling, ... );
 
 Sets the passed in object(s) to have the same parent 
 as the calling object.  Returns 1 on success and 
@@ -198,7 +247,7 @@ as the calling object.  Returns 1 on success and
 
 =cut
 
-sub attach_sibling {
+sub add_sibling {
     my $self = shift;
     my $return = 1;
     foreach my $node (@_) {
@@ -207,6 +256,8 @@ sub attach_sibling {
     return $return;
 }
 
+
+
 =head2 is_leaf
 
   if ($obj->is_leaf()) { ... }
@@ -223,6 +274,8 @@ sub is_leaf {
     )->count();
 }
 
+
+
 =head2 is_root
 
   if ($obj->is_root()) { ... }
@@ -236,6 +289,8 @@ sub is_root {
     return ( $self->get_column( $self->_parent_column ) ? 1 : 0 );
 }
 
+
+
 =head2 is_branch
 
   if ($obj->is_branch()) { ... }
@@ -247,9 +302,97 @@ Returns 0 otherwise.
 
 sub is_branch {
     my( $self ) = @_;
-    return ( ($self->is_leaf() or $self->is_root()) ? 0 : 1 );
+    return !($self->is_leaf() or $self->is_root());
+}
+
+
+
+=head2 descendents
+
+Returns a flat list of *all* the node's descendents.
+Dangerously recursive. Use with extreme caution. May contain
+nuts.
+
+=cut
+
+sub descendents {
+    my $self  = shift;
+    my @descendents;
+    for my $child ($self->children) {
+        push @descendents, $child, $child->descendents;
+    }
+    return @descendents;
+}
+
+
+
+=head2 pharaoh_delete
+
+Deletes a node and all it's children (even if cascade_delete is off)
+
+=cut
+
+sub pharaoh_delete {
+    my $self = shift;
+    for my $child ($self->children) {
+        $child->pharaoh_delete;
+    }
+    $self->delete;
 }
 
+
+
+=head2 grandmother_delete
+
+Deletes a node and sends all its children to live with their grandmother
+
+=cut
+
+sub grandmother_delete {
+    my $self = shift;
+    $self->parent->add_children($self->children);
+    $self->delete;
+}
+
+
+
+=head2 promote_eldest_child_delete
+
+Deletes a node and promotes the first of it children to take its place.
+If that node already had children, they will now be siblings of the new
+parent node's former siblings (which are now its children).
+
+=cut
+
+sub promote_eldest_child_delete {
+    my $self = shift;
+    my @children = $self->children;
+    my $eldest = shift @children;
+    $eldest->set_parent($self->parent);
+    $eldest->add_children(@children);
+    $self->delete;
+}
+    
+
+
+=head2 
+
+Replaces the current node with the given replacement, and then deletes the
+current node.  The replacement node with have the old node's parent, and its
+children will be the union of its original children and the old node's 
+children.
+
+=cut
+
+sub replace_with_and_delete {
+    my ($self, $replacement) = @_;
+    $replacement->add_children($self->children);
+    $replacement->set_parent($self->parent);
+    $self->delete;
+}
+
+
+
 =head2 set_primary_key
 
 This method is an override of DBIx::Class' method for setting the 
@@ -260,7 +403,7 @@ an error will be thrown.
 
 =cut
 
-sub set_primary_ley {
+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');