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');
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();
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();
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
=cut
-sub attach_child {
+sub add_child {
my $self = shift;
my $return = 1;
foreach my $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();
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
=cut
-sub attach_sibling {
+sub add_sibling {
my $self = shift;
my $return = 1;
foreach my $node (@_) {
return $return;
}
+
+
=head2 is_leaf
if ($obj->is_leaf()) { ... }
)->count();
}
+
+
=head2 is_root
if ($obj->is_root()) { ... }
return ( $self->get_column( $self->_parent_column ) ? 1 : 0 );
}
+
+
=head2 is_branch
if ($obj->is_branch()) { ... }
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
=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');
our $NODE_COUNT = 80;
sub count_tests {
- my $count = 13;
+ my $count = 22;
if( TreeTest::Schema::Node->can('position_column') ){
$count ++;
}
ok( ($nodes->find(22)->children->count()==2), 'node 22 has correct number of children' );
ok( ($nodes->find(22)->siblings->count()==3), 'node 22 has correct number of siblings' );
- $nodes->find(22)->attach_child( $nodes->find(3) );
+ $nodes->find(22)->add_child( $nodes->find(3) );
ok( ($nodes->find(22)->children->count()==3), 'node 22 has correct number of children' );
ok( ($nodes->find(22)->siblings->count()==2), 'node 22 has correct number of siblings' );
- $nodes->find(22)->attach_sibling( $nodes->find(3) );
+ $nodes->find(22)->add_sibling( $nodes->find(3) );
ok( ($nodes->find(22)->children->count()==2), 'node 22 has correct number of children' );
ok( ($nodes->find(22)->siblings->count()==3), 'node 22 has correct number of siblings' );
if( TreeTest::Schema::Node->can('position_column') ){
ok( check_positions(scalar $root->children()), 'positions are correct' );
}
+
+ #$nodes->delete;
+ $schema = TreeTest::Schema->connect();
+ $nodes = $schema->resultset('Node');
+ $root = $nodes->create({ name=>'root' });
+ @parents = (
+ 1,1,3,2,3,3,6,6,2,5,3,5,12,1
+ );
+ foreach my $parent_id (@parents) {
+ my $node = $nodes->create({ name=>'child' });
+ $node->parent( $parent_id );
+ }
+
+ ok ($nodes->find(1)->descendents == 14, 'root node has 14 descendents');
+ ok ($nodes->find(2)->descendents == 4, 'node 2 has 4 descendents');
+ ok ($nodes->find(6)->descendents == 2, 'node 6 has 2 descendents');
+ ok ($nodes->find(10)->descendents == 0, 'node 10 has no descendents');
+
+ $nodes->find(2)->pharaoh_delete;
+ ok ($nodes->find(1)->descendents == 9, 'root node has 9 descendents after pharaohing node 2');
+
+ ok ($nodes->find(3)->children == 4, 'node 3 has 4 children');
+ $nodes->find(6)->grandmother_delete;
+ ok ($nodes->find(3)->children == 5, 'node 3 has 5 children after node 6 dies');
+
+ $nodes->find(3)->replace_with_and_delete($nodes->find(12));
+ ok ($nodes->find(12)->children == 5, 'node 12 has 5 children after taking over from node 3');
+ ok ($nodes->find(7)->parent->id == 12, 'node 7\'s parent is node 12');
+
+
+
+
}
sub check_positions {
projects / dbsrgits/DBIx-Class-Tree.git / commitdiff