1 # vim: ts=8:sw=4:sts=4:et
2 package DBIx::Class::Tree::AdjacencyList;
5 use base qw( DBIx::Class );
10 DBIx::Class::Tree::AdjacencyList - Manage a tree of data using the common adjacency list model. (EXPERIMENTAL)
14 Create a table for your tree data.
16 CREATE TABLE employees (
17 employee_id INTEGER PRIMARY KEY AUTOINCREMENT,
18 parent_id INTEGER NOT NULL,
22 In your Schema or DB class add Tree::AdjacencyList to the top
23 of the component list.
25 __PACKAGE__->load_components(qw( Tree::AdjacencyList ... ));
27 Specify the column that contains the parent ID of each row.
30 __PACKAGE__->parent_column('parent_id');
32 Thats it, now you can modify and analyze the tree.
37 my $employee = My::Employee->create({ name=>'Matt S. Trout' });
39 my $rs = $employee->children();
40 my @siblings = $employee->children();
42 my $parent = $employee->parent();
43 $employee->parent( 7 );
47 This module provides methods for working with adjacency lists. The
48 adjacency list model is a very common way of representing a tree structure.
49 In this model each row in a table has a prent ID column that references the
50 primary key of another row in the same table. Because of this the primary
51 key must only be one column and is usually some sort of integer. The row
52 with a parent ID of 0 is the root row and is usually the parent of all
59 __PACKAGE__->parent_column('parent_id');
61 Declares the name of the column that contains the self-referential
62 ID which defines the parent row. Defaults to "parent_id".
66 __PACKAGE__->mk_classdata( 'parent_column' => 'parent_id' );
70 my $parent = $employee->parent();
71 $employee->parent( $parent_obj );
72 $employee->parent( $parent_id );
74 Retrieves the object's parent ID, or sets the object's
75 parent ID. If setting the parent ID then 0 will be returned
76 if the object already has the specified parent, and 1 on
82 my( $self, $new_parent ) = @_;
83 my $parent_column = $self->parent_column();
85 if (ref($new_parent)) {
86 $new_parent = $new_parent->id() || 0;
88 return 0 if ($new_parent == ($self->get_column($parent_column)||0));
89 $self->set_column( $parent_column => $new_parent );
94 return $self->find( $self->get_column( $parent_column ) );
100 my $children_rs = $employee->children();
101 my @children = $employee->children();
103 Returns a list or record set, depending on context, of all
104 the objects one level below the current one.
110 my $rs = $self->result_source->resultset->search(
111 { $self->parent_column()=>$self->id() }
113 return $rs->all() if (wantarray());
119 $parent->attach_child( $child );
121 Sets (or moves) the child to the new parent.
126 my( $self, $child ) = @_;
127 $child->parent( $self );
130 =head2 attach_sibling
132 $this->attach_sibling( $that );
134 Sets the passed in object to have the same parent
135 as the calling object.
140 my( $self, $child ) = @_;
141 $child->parent( $self->parent() );
149 Aran Clary Deltac <bluefeet@cpan.org>
153 You may distribute this code under the same terms as Perl itself.