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 ... ));
26 # If you want positionable data make sure this
27 # module comes first, as in:
28 __PACKAGE__->load_components(qw( Tree::AdjacencyList Positional ... ));
30 Specify the column that contains the parent ID each row.
33 __PACKAGE__->parent_column('parent_id');
35 Thats it, now you can modify and analyze the tree.
40 my $employee = My::Employee->create({ name=>'Matt S. Trout' });
42 my $rs = $employee->children();
43 my @siblings = $employee->children();
45 my $parent = $employee->parent();
46 $employee->parent( 7 );
50 This module provides methods for working with adjacency lists. The
51 adjacency list model is a very common way of representing a tree structure.
52 In this model each row in a table has a prent ID column that references the
53 primary key of another row in the same table. Because of this the primary
54 key must only be one column and is usually some sort of integer. The row
55 with a parent ID of 0 is the root row and is usually the parent of all
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".
67 If you are useing the L<DBIx::Class::Positional> component then this
68 parent_column will automatically be used as the collection_column.
72 __PACKAGE__->mk_classdata( 'parent_column' => 'parent_id' );
76 my $parent = $employee->parent();
77 $employee->parent( $parent_obj );
78 $employee->parent( $parent_id );
80 Retrieves the object's parent ID, or sets the object's
81 parent ID. If setting the parent ID then 0 will be returned
82 if the object already has the specified parent, and 1 on
85 If you are using the L<DBIx::Class::Positional> component this
86 module will first move the object to the last position of
87 the list, change the parent ID, then move the object to the
88 last position of the new list. This ensures the intergrity
94 my( $self, $new_parent ) = @_;
95 my $parent_column = $self->parent_column();
97 if (ref($new_parent)) {
98 $new_parent = $new_parent->id() || 0;
100 return 0 if ($new_parent == ($self->get_column($parent_column)||0));
101 $self->move_last() if ($self->positional());
102 $self->set_column( $parent_column => $new_parent );
103 if ($self->positional()) {
105 $self->position_column() => $self->search( {$self->_collection_clause()} )->count() + 1
112 return $self->find( $self->get_column( $parent_column ) );
118 my $children_rs = $employee->children();
119 my @children = $employee->children();
121 Returns a list or record set, depending on context, of all
122 the objects one level below the current one.
124 If you are using the L<DBIx::Class::Positional> component then this method
125 will return the children sorted by the position column.
131 my $rs = $self->search(
132 { $self->parent_column()=>$self->id() },
133 ( $self->isa('DBIx::Class::Position') ? {order_by=>$self->position_column()} : () )
135 return $rs->all() if (wantarray());
141 $parent->attach_child( $child );
143 Sets (or moves) the child to the new parent.
148 my( $self, $child ) = @_;
149 $child->parent( $self );
152 =head2 attach_sibling
154 $this->attach_sibling( $that );
156 Sets the passed in object to have the same parent
157 as the calling object.
162 my( $self, $child ) = @_;
163 $child->parent( $self->parent() );
166 =head1 POSITIONAL METHODS
168 If you are useing the L<DBIx::Class::Postional> component
169 in conjunction with this module then you will also have
170 these methods available to you.
174 $parent->append_child( $child );
176 Sets the child to have the specified parent and moves the
177 child to the last position.
182 my( $self, $child ) = @_;
183 croak('This method may only be used with the Positional component') if (!$self->positional());
184 $child->parent( $self );
189 $parent->prepend_child( $child );
191 Sets the child to have the specified parent and moves the
192 child to the first position.
197 my( $self, $child ) = @_;
198 croak('This method may only be used with the Positional component') if (!$self->positional());
199 $child->parent( $self );
200 $child->move_first();
205 $this->attach_before( $that );
207 Attaches the object at the position just before the
208 calling object's position.
213 my( $self, $sibling ) = @_;
214 croak('This method may only be used with the Positional component') if (!$self->positional());
215 $sibling->parent( $self->parent() );
216 $sibling->move_to( $self->get_column($self->position_column()) );
221 $this->attach_after( $that );
223 Attaches the object at the position just after the
224 calling object's position.
229 my( $self, $sibling ) = @_;
230 croak('This method may only be used with the Positional component') if (!$self->positional());
231 $sibling->parent( $self->parent() );
232 $sibling->move_to( $self->get_column($self->position_column()) + 1 );
237 if ($object->positional()) { ... }
239 Returns true if the object is a DBIx::Class::Positional
246 return $self->isa('DBIx::Class::Positional');
249 =head1 PRIVATE METHODS
251 These methods are used internally. You should never have the
254 =head2 _collection_clause
256 This method is provided as an override of the method in
257 L<DBIx::Class::Positional>. This way Positional and Tree::AdjacencyList
258 may be used together without conflict. Make sure that in
259 your component list that you load Tree::AdjacencyList before you
264 sub _collection_clause {
267 $self->parent_column() =>
268 $self->get_column($self->parent_column())
277 Aran Clary Deltac <bluefeet@cpan.org>
281 You may distribute this code under the same terms as Perl itself.