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 DEFAULT 0,
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". This
63 will create a has_many (children) and belongs_to (parent)
68 __PACKAGE__->mk_classdata( '_parent_column' => 'parent_id' );
73 my $parent_col = shift;
74 my $primary_col = ($class->primary_columns())[0];
75 $class->belongs_to( '_parent' => $class => { "foreign.$primary_col" => "self.$parent_col" } );
76 $class->has_many( 'children' => $class => { "foreign.$parent_col" => "self.$primary_col" } );
77 $class->_parent_column( $parent_col );
80 return $class->_parent_column();
85 my $parent = $employee->parent();
86 $employee->parent( $parent_obj );
87 $employee->parent( $parent_id );
89 Retrieves the object's parent object, or changes the object's
90 parent to the specified parent or parent ID.
97 my $new_parent = shift;
98 my $parent_col = $self->_parent_column();
99 if (ref($new_parent)) {
100 $new_parent = $new_parent->id() || croak('Parent object does not have an ID');;
102 return 0 if ($new_parent == ($self->get_column($parent_col)||0));
103 $self->set_column( $parent_col => $new_parent );
107 return $self->_parent();
112 my $children_rs = $employee->children();
113 my @children = $employee->children();
115 Returns a list or record set, depending on context, of all
116 the objects one level below the current one. This method
117 is created when parent_column() is called, which sets up a
118 has_many relationship called children.
122 $parent->attach_child( $child );
124 Sets the child to the new parent.
129 my( $self, $child ) = @_;
130 return $child->parent( $self );
135 my $rs = $node->siblings();
136 my @siblings = $node->siblings();
138 Returns either a result set or an array of all other objects
139 with the same parent as the calling object.
145 my $parent_col = $self->_parent_column;
146 my $primary_col = ($self->primary_columns())[0];
147 my $rs = $self->result_source->resultset->search(
149 $parent_col => $self->get_column($parent_col),
150 $primary_col => { '!=' => $self->get_column($primary_col) },
153 return $rs->all() if (wantarray());
159 =head2 attach_sibling
161 $this->attach_sibling( $that );
163 Sets the passed in object to have the same parent
164 as the calling object.
169 my( $self, $node ) = @_;
170 return $node->parent( $self->parent() );
178 Aran Clary Deltac <bluefeet@cpan.org>
182 You may distribute this code under the same terms as Perl itself.