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 ); |
6 | |
7 | =head1 NAME |
8 | |
9 | DBIx::Class::Tree::AdjacencyList - Manage a tree of data using the common adjacency list model. |
10 | |
11 | =head1 SYNOPSIS |
12 | |
13 | Create a table for your tree data. |
14 | |
15 | CREATE TABLE employees ( |
16 | employee_id INTEGER PRIMARY KEY AUTOINCREMENT, |
17 | parent_id INTEGER NOT NULL, |
18 | name TEXT NOT NULL |
19 | ); |
20 | |
21 | In your Schema or DB class add Tree::AdjacencyList to the top |
22 | of the component list. |
23 | |
24 | __PACKAGE__->load_components(qw( Tree::AdjacencyList ... )); |
25 | # If you want positionable data make sure this |
26 | # module comes first, as in: |
27 | __PACKAGE__->load_components(qw( Tree::AdjacencyList Positioned ... )); |
28 | |
29 | Specify the column that contains the parent ID each row. |
30 | |
31 | package My::Employee; |
32 | __PACKAGE__->parent_column('parent_id'); |
33 | |
34 | Thats it, now you can modify and analyze the tree. |
35 | |
36 | #!/use/bin/perl |
37 | use My::Employee; |
38 | |
39 | my $employee = My::Employee->create({ name=>'Matt S. Trout' }); |
40 | |
41 | my $rs = $employee->children(); |
42 | my @siblings = $employee->children(); |
43 | |
44 | my $parent = $employee->parent(); |
45 | $employee->parent( 7 ); |
46 | |
47 | =head1 DESCRIPTION |
48 | |
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 row and is usually the parent of all |
55 | other rows. |
56 | |
57 | =head1 METHODS |
58 | |
59 | =head2 parent_column |
60 | |
61 | __PACKAGE__->parent_column('parent_id'); |
62 | |
63 | Declares the name of the column that contains the self-referential |
64 | ID which defines the parent row. Defaults to "parent_id". |
65 | |
66 | =cut |
67 | |
68 | __PACKAGE__->mk_classdata( 'parent_column' => 'parent_id' ); |
69 | |
70 | =head2 parent |
71 | |
72 | my $parent = $employee->parent(); |
73 | $employee->parent( $parent_obj ); |
74 | $employee->parent( $parent_id ); |
75 | |
76 | Retrieves the object's parent ID, or sets the object's |
77 | parent ID. If setting the parent ID then 0 will be returned |
78 | if the object already has the specified parent, and 1 on |
79 | success. |
80 | |
81 | If you are using the Positioned component this |
82 | module will first move the object to the last position of |
83 | the list, change the parent ID, then move the object to the |
84 | last position of the new list. This ensures the intergrity |
85 | of the positions. |
86 | |
87 | =cut |
88 | |
89 | sub parent { |
90 | my( $self, $new_parent ) = @_; |
91 | my $parent_column = $self->parent_column(); |
92 | if ($new_parent) { |
93 | if (ref($new_parent)) { |
94 | $new_parent = $new_parent->id(); |
95 | } |
96 | return 0 if ($new_parent == $self->get_column($parent_column)); |
97 | my $positioned = $self->can('position_column'); |
98 | $self->move_last if ($positioned); |
99 | $self->set_column( $parent_column => $new_parent ); |
100 | if ($positioned) { |
101 | $self->set_column( |
102 | $self->position_column() => $self->search( {$self->_parent_clause()} )->count() + 1 |
103 | ); |
104 | } |
105 | $self->update(); |
106 | return 1; |
107 | } |
108 | else { |
109 | return $self->find( $self->get_column( $parent_column ) ); |
110 | } |
111 | } |
112 | |
113 | =head2 children |
114 | |
115 | my $children_rs = $employee->children(); |
116 | my @children = $employee->children(); |
117 | |
118 | Returns a list or record set, depending on context, of all |
119 | the objects one level below the current one. |
120 | |
121 | If you are using the Positioned component then this method |
122 | will return the children sorted by the position column. |
123 | |
124 | =cut |
125 | |
126 | sub children { |
127 | my( $self ) = @_; |
128 | my $rs = $self->search( |
129 | { $self->parent_column()=>$self->id() }, |
130 | ( $self->can('position_column') ? {order_by=>$self->position_column()} : () ) |
131 | ); |
132 | return $rs->all() if (wantarray()); |
133 | return $rs; |
134 | } |
135 | |
136 | =head2 descendents |
137 | |
138 | Same as children. Declared so that this module is |
139 | compatible with the Tree::NestedSet module. |
140 | |
141 | =cut |
142 | |
143 | #*descendants = \&children; |
144 | |
145 | =head1 PRIVATE METHODS |
146 | |
147 | These methods are used internally. You should never have the |
148 | need to use them. |
149 | |
150 | =head2 _parent_clause |
151 | |
152 | This method is provided as an override of the method in |
153 | DBIC::Positioned. This way Positioned and Tree::AdjacencyList |
154 | may be used together without conflict. Make sure that in |
155 | you component list that you load Tree::AdjacencyList before you |
156 | load Positioned. |
157 | |
158 | This method assumes a parent ID of 0 if none is defined. This |
159 | usually comes in to play if you are just createing the object |
160 | and it has not yet been assigned a parent. |
161 | |
162 | =cut |
163 | |
164 | sub _parent_clause { |
165 | my( $self ) = @_; |
166 | return ( |
167 | $self->parent_column() => |
168 | $self->get_column($self->parent_column()) || 0 |
169 | ); |
170 | } |
171 | |
172 | 1; |
173 | __END__ |
174 | |
175 | =head1 AUTHOR |
176 | |
177 | Aran Deltac <bluefeet@cpan.org> |
178 | |
179 | =head1 LICENSE |
180 | |
181 | You may distribute this code under the same terms as Perl itself. |
182 | |