Commit | Line | Data |
7a76f44c |
1 | # vim: ts=8:sw=4:sts=4:et |
2 | package DBIx::Class::Tree::AdjacencyList; |
3 | use strict; |
4 | use warnings; |
5 | use base qw( DBIx::Class ); |
af75accb |
6 | use Carp qw( croak ); |
7a76f44c |
7 | |
8 | =head1 NAME |
9 | |
10 | DBIx::Class::Tree::AdjacencyList - Manage a tree of data using the common adjacency list model. |
11 | |
12 | =head1 SYNOPSIS |
13 | |
14 | Create a table for your tree data. |
15 | |
16 | CREATE TABLE employees ( |
17 | employee_id INTEGER PRIMARY KEY AUTOINCREMENT, |
18 | parent_id INTEGER NOT NULL, |
19 | name TEXT NOT NULL |
20 | ); |
21 | |
22 | In your Schema or DB class add Tree::AdjacencyList to the top |
23 | of the component list. |
24 | |
25 | __PACKAGE__->load_components(qw( Tree::AdjacencyList ... )); |
26 | # If you want positionable data make sure this |
27 | # module comes first, as in: |
1e3ff014 |
28 | __PACKAGE__->load_components(qw( Tree::AdjacencyList Positional ... )); |
7a76f44c |
29 | |
30 | Specify the column that contains the parent ID each row. |
31 | |
32 | package My::Employee; |
33 | __PACKAGE__->parent_column('parent_id'); |
34 | |
35 | Thats it, now you can modify and analyze the tree. |
36 | |
37 | #!/use/bin/perl |
38 | use My::Employee; |
39 | |
40 | my $employee = My::Employee->create({ name=>'Matt S. Trout' }); |
41 | |
42 | my $rs = $employee->children(); |
43 | my @siblings = $employee->children(); |
44 | |
45 | my $parent = $employee->parent(); |
46 | $employee->parent( 7 ); |
47 | |
48 | =head1 DESCRIPTION |
49 | |
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 |
56 | other rows. |
57 | |
58 | =head1 METHODS |
59 | |
60 | =head2 parent_column |
61 | |
62 | __PACKAGE__->parent_column('parent_id'); |
63 | |
64 | Declares the name of the column that contains the self-referential |
65 | ID which defines the parent row. Defaults to "parent_id". |
66 | |
1e3ff014 |
67 | If you are useing the L<DBIx::Class::Positional> component then this |
68 | parent_column will automatically be used as the collection_column. |
0a298c73 |
69 | |
7a76f44c |
70 | =cut |
71 | |
72 | __PACKAGE__->mk_classdata( 'parent_column' => 'parent_id' ); |
73 | |
74 | =head2 parent |
75 | |
76 | my $parent = $employee->parent(); |
77 | $employee->parent( $parent_obj ); |
78 | $employee->parent( $parent_id ); |
79 | |
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 |
83 | success. |
84 | |
1e3ff014 |
85 | If you are using the L<DBIx::Class::Positional> component this |
7a76f44c |
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 |
89 | of the positions. |
90 | |
91 | =cut |
92 | |
93 | sub parent { |
94 | my( $self, $new_parent ) = @_; |
95 | my $parent_column = $self->parent_column(); |
96 | if ($new_parent) { |
97 | if (ref($new_parent)) { |
80021def |
98 | $new_parent = $new_parent->id() || 0; |
7a76f44c |
99 | } |
80021def |
100 | return 0 if ($new_parent == ($self->get_column($parent_column)||0)); |
af75accb |
101 | $self->move_last() if ($self->positional()); |
7a76f44c |
102 | $self->set_column( $parent_column => $new_parent ); |
af75accb |
103 | if ($self->positional()) { |
7a76f44c |
104 | $self->set_column( |
0a298c73 |
105 | $self->position_column() => $self->search( {$self->_collection_clause()} )->count() + 1 |
7a76f44c |
106 | ); |
107 | } |
108 | $self->update(); |
109 | return 1; |
110 | } |
111 | else { |
112 | return $self->find( $self->get_column( $parent_column ) ); |
113 | } |
114 | } |
115 | |
116 | =head2 children |
117 | |
118 | my $children_rs = $employee->children(); |
119 | my @children = $employee->children(); |
120 | |
121 | Returns a list or record set, depending on context, of all |
122 | the objects one level below the current one. |
123 | |
1e3ff014 |
124 | If you are using the L<DBIx::Class::Positional> component then this method |
7a76f44c |
125 | will return the children sorted by the position column. |
126 | |
127 | =cut |
128 | |
129 | sub children { |
130 | my( $self ) = @_; |
131 | my $rs = $self->search( |
132 | { $self->parent_column()=>$self->id() }, |
0a298c73 |
133 | ( $self->isa('DBIx::Class::Position') ? {order_by=>$self->position_column()} : () ) |
7a76f44c |
134 | ); |
135 | return $rs->all() if (wantarray()); |
136 | return $rs; |
137 | } |
138 | |
af75accb |
139 | =head2 attach_child |
140 | |
141 | $parent->attach_child( $child ); |
142 | |
143 | Sets (or moves) the child to the new parent. |
144 | |
145 | =cut |
146 | |
147 | sub attach_child { |
148 | my( $self, $child ) = @_; |
149 | $child->parent( $self ); |
150 | } |
151 | |
152 | =head2 attach_sibling |
153 | |
154 | $this->attach_sibling( $that ); |
155 | |
156 | Sets the passed in object to have the same parent |
157 | as the calling object. |
158 | |
159 | =cut |
160 | |
161 | sub attach_sibling { |
162 | my( $self, $child ) = @_; |
163 | $child->parent( $self->parent() ); |
164 | } |
165 | |
166 | =head1 POSITIONAL METHODS |
167 | |
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. |
171 | |
172 | =head2 append_child |
173 | |
174 | $parent->append_child( $child ); |
175 | |
176 | Sets the child to have the specified parent and moves the |
177 | child to the last position. |
178 | |
179 | =cut |
180 | |
181 | sub append_child { |
182 | my( $self, $child ) = @_; |
183 | croak('This method may only be used with the Positional component') if (!$self->positional()); |
184 | $child->parent( $self ); |
185 | } |
186 | |
187 | =head2 prepend_child |
188 | |
189 | $parent->prepend_child( $child ); |
190 | |
191 | Sets the child to have the specified parent and moves the |
192 | child to the first position. |
193 | |
194 | =cut |
195 | |
196 | sub prepend_child { |
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(); |
201 | } |
202 | |
203 | =head2 attach_before |
204 | |
205 | $this->attach_before( $that ); |
206 | |
207 | Attaches the object at the position just before the |
208 | calling object's position. |
209 | |
210 | =cut |
211 | |
212 | sub attach_before { |
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()) ); |
217 | } |
218 | |
219 | =head2 attach_after |
220 | |
221 | $this->attach_after( $that ); |
222 | |
223 | Attaches the object at the position just after the |
224 | calling object's position. |
225 | |
226 | =cut |
227 | |
228 | sub attach_after { |
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 ); |
233 | } |
234 | |
235 | =head2 positional |
236 | |
237 | if ($object->positional()) { ... } |
238 | |
239 | Returns true if the object is a DBIx::Class::Positional |
240 | object. |
241 | |
242 | =cut |
243 | |
244 | sub positional { |
245 | my( $self ) = @_; |
246 | return $self->isa('DBIx::Class::Positional'); |
247 | } |
248 | |
7a76f44c |
249 | =head1 PRIVATE METHODS |
250 | |
251 | These methods are used internally. You should never have the |
252 | need to use them. |
253 | |
0a298c73 |
254 | =head2 _collection_clause |
7a76f44c |
255 | |
256 | This method is provided as an override of the method in |
1e3ff014 |
257 | L<DBIx::Class::Positional>. This way Positional and Tree::AdjacencyList |
7a76f44c |
258 | may be used together without conflict. Make sure that in |
0a298c73 |
259 | your component list that you load Tree::AdjacencyList before you |
1e3ff014 |
260 | load Positional. |
7a76f44c |
261 | |
7a76f44c |
262 | =cut |
263 | |
0a298c73 |
264 | sub _collection_clause { |
7a76f44c |
265 | my( $self ) = @_; |
266 | return ( |
267 | $self->parent_column() => |
80021def |
268 | $self->get_column($self->parent_column()) |
7a76f44c |
269 | ); |
270 | } |
271 | |
272 | 1; |
273 | __END__ |
274 | |
275 | =head1 AUTHOR |
276 | |
0a298c73 |
277 | Aran Clary Deltac <bluefeet@cpan.org> |
7a76f44c |
278 | |
279 | =head1 LICENSE |
280 | |
281 | You may distribute this code under the same terms as Perl itself. |
282 | |