1 package DBIx::Class::Tree::AdjacencyList;
2 # vim: ts=8:sw=4:sts=4:et
7 use base qw( DBIx::Class );
12 DBIx::Class::Tree::AdjacencyList - Manage a tree of data using the common adjacency list model. (EXPERIMENTAL)
16 Create a table for your tree data.
18 CREATE TABLE employees (
19 employee_id INTEGER PRIMARY KEY AUTOINCREMENT,
20 parent_id INTEGER NOT NULL DEFAULT 0,
24 In your Schema or DB class add Tree::AdjacencyList to the top
25 of the component list.
27 __PACKAGE__->load_components(qw( Tree::AdjacencyList ... ));
29 Specify the column that contains the parent ID of each row.
32 __PACKAGE__->parent_column('parent_id');
34 Thats it, now you can modify and analyze the tree.
39 my $employee = My::Employee->create({ name=>'Matt S. Trout' });
41 my $rs = $employee->children();
42 my @siblings = $employee->children();
44 my $parent = $employee->parent();
45 $employee->parent( 7 );
49 This module provides methods for working with adjacency lists. The
50 adjacency list model is a very common way of representing a tree structure.
51 In this model each row in a table has a prent ID column that references the
52 primary key of another row in the same table. Because of this the primary
53 key must only be one column and is usually some sort of integer. The row
54 with a parent ID of 0 is the root node and is usually the parent of all
55 other rows. Although, there is no limitation in this module that would
56 stop you from having multiple root nodes.
62 __PACKAGE__->parent_column('parent_id');
64 Declares the name of the column that contains the self-referential
65 ID which defines the parent row. Defaults to "parent_id". This
66 will create a has_many (children) and belongs_to (parent)
69 This method also setups an additional has_many relationship called
70 parents which is useful when you want to treat an adjacency list
75 __PACKAGE__->mk_classdata( '_parent_column' => 'parent_id' );
80 my $parent_col = shift;
81 my $primary_col = ($class->primary_columns())[0];
82 $class->belongs_to( '_parent' => $class => { "foreign.$primary_col" => "self.$parent_col" } );
83 $class->has_many( 'children' => $class => { "foreign.$parent_col" => "self.$primary_col" } );
84 $class->has_many( 'parents' => $class => { "foreign.$primary_col" => "self.$parent_col" } );
85 $class->_parent_column( $parent_col );
88 return $class->_parent_column();
93 my $parent = $employee->parent();
94 $employee->parent( $parent_obj );
95 $employee->parent( $parent_id );
97 Retrieves the object's parent object, or changes the object's
98 parent to the specified parent or parent ID. If you would like
99 to make the object the root node, just set the parent to 0.
101 If you are setting the parent then 0 will be returned if the
102 specified parent is already the object's parent and 1 on
110 my $new_parent = shift;
111 my $parent_col = $self->_parent_column();
112 if (ref($new_parent)) {
113 $new_parent = $new_parent->id() || croak('Parent object does not have an ID');;
115 return 0 if ($new_parent == ($self->get_column($parent_col)||0));
116 $self->set_column( $parent_col => $new_parent );
120 return $self->_parent();
125 my $parents = $node->parents();
126 my @parents = $node->parents();
128 This has_many relationship is not that useful as it will
129 never return more than one parent due to the one-to-many
130 structure of adjacency lists. The reason this relationship
131 is defined is so that this tree type may be treated as if
136 my $children_rs = $employee->children();
137 my @children = $employee->children();
139 Returns a list or record set, depending on context, of all
140 the objects one level below the current one. This method
141 is created when parent_column() is called, which sets up a
142 has_many relationship called children.
146 $parent->attach_child( $child );
147 $parent->attach_child( $child, $child, ... );
149 Sets the child, or children, to the new parent. Returns 1
150 on success and returns 0 if the parent object already has
158 foreach my $child (@_) {
159 $child->parent( $self );
166 my $rs = $node->siblings();
167 my @siblings = $node->siblings();
169 Returns either a result set or an array of all other objects
170 with the same parent as the calling object.
176 my $parent_col = $self->_parent_column;
177 my $primary_col = ($self->primary_columns())[0];
178 my $rs = $self->result_source->resultset->search(
180 $parent_col => $self->get_column($parent_col),
181 $primary_col => { '!=' => $self->get_column($primary_col) },
184 return $rs->all() if (wantarray());
190 =head2 attach_sibling
192 $obj->attach_sibling( $sibling );
193 $obj->attach_sibling( $sibling, $sibling, ... );
195 Sets the passed in object(s) to have the same parent
196 as the calling object. Returns 1 on success and
197 0 if the sibling already has the same parent.
204 foreach my $node (@_) {
205 $return = 0 if (!$node->parent( $self->parent() ));
212 if ($obj->is_leaf()) { ... }
214 Returns 1 if the object has no children, and 0 otherwise.
220 return $self->result_source->resultset->search(
221 { $self->_parent_column => $self->id() },
228 if ($obj->is_root()) { ... }
230 Returns 1 if the object has no parent, and 0 otherwise.
236 return ( $self->get_column( $self->_parent_column ) ? 1 : 0 );
241 if ($obj->is_branch()) { ... }
243 Returns 1 if the object has a parent and has children.
250 return ( ($self->is_leaf() or $self->is_root()) ? 0 : 1 );
253 =head2 set_primary_key
255 This method is an override of DBIx::Class' method for setting the
256 class' primary key column(s). This method passes control right on
257 to the normal method after first validating that only one column is
258 being selected as a primary key. If more than one column is then
259 an error will be thrown.
263 sub set_primary_ley {
266 croak('You may only specify a single column as the primary key for adjacency tree classes');
268 return $self->next::method( @_ );
274 =head1 INHERITED METHODS
282 L<mk_classdata|DBIx::Class/mk_classdata>
286 L<component_base_class|DBIx::Class/component_base_class>
290 =head2 DBIx::Class::Componentised
296 L<inject_base|DBIx::Class::Componentised/inject_base>
300 L<load_components|DBIx::Class::Componentised/load_components>
304 L<load_own_components|DBIx::Class::Componentised/load_own_components>
308 =head2 Class::Data::Accessor
314 L<mk_classaccessor|Class::Data::Accessor/mk_classaccessor>
320 Aran Clary Deltac <bluefeet@cpan.org>
324 You may distribute this code under the same terms as Perl itself.