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 | |
0a298c73 |
66 | If you are useing the Positioned component then this parent_column |
67 | will automatically be used as the collection_column. |
68 | |
7a76f44c |
69 | =cut |
70 | |
71 | __PACKAGE__->mk_classdata( 'parent_column' => 'parent_id' ); |
72 | |
73 | =head2 parent |
74 | |
75 | my $parent = $employee->parent(); |
76 | $employee->parent( $parent_obj ); |
77 | $employee->parent( $parent_id ); |
78 | |
79 | Retrieves the object's parent ID, or sets the object's |
80 | parent ID. If setting the parent ID then 0 will be returned |
81 | if the object already has the specified parent, and 1 on |
82 | success. |
83 | |
84 | If you are using the Positioned component this |
85 | module will first move the object to the last position of |
86 | the list, change the parent ID, then move the object to the |
87 | last position of the new list. This ensures the intergrity |
88 | of the positions. |
89 | |
90 | =cut |
91 | |
92 | sub parent { |
93 | my( $self, $new_parent ) = @_; |
94 | my $parent_column = $self->parent_column(); |
95 | if ($new_parent) { |
96 | if (ref($new_parent)) { |
80021def |
97 | $new_parent = $new_parent->id() || 0; |
7a76f44c |
98 | } |
80021def |
99 | return 0 if ($new_parent == ($self->get_column($parent_column)||0)); |
0a298c73 |
100 | my $is_positioned = $self->isa('DBIx::Class::Positioned'); |
101 | $self->move_last() if ($is_positioned); |
7a76f44c |
102 | $self->set_column( $parent_column => $new_parent ); |
0a298c73 |
103 | if ($is_positioned) { |
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 | |
124 | If you are using the Positioned component then this method |
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 | |
7a76f44c |
139 | =head1 PRIVATE METHODS |
140 | |
141 | These methods are used internally. You should never have the |
142 | need to use them. |
143 | |
0a298c73 |
144 | =head2 _collection_clause |
7a76f44c |
145 | |
146 | This method is provided as an override of the method in |
0a298c73 |
147 | DBIx::Class::Positioned. This way Positioned and Tree::AdjacencyList |
7a76f44c |
148 | may be used together without conflict. Make sure that in |
0a298c73 |
149 | your component list that you load Tree::AdjacencyList before you |
7a76f44c |
150 | load Positioned. |
151 | |
7a76f44c |
152 | =cut |
153 | |
0a298c73 |
154 | sub _collection_clause { |
7a76f44c |
155 | my( $self ) = @_; |
156 | return ( |
157 | $self->parent_column() => |
80021def |
158 | $self->get_column($self->parent_column()) |
7a76f44c |
159 | ); |
160 | } |
161 | |
162 | 1; |
163 | __END__ |
164 | |
165 | =head1 AUTHOR |
166 | |
0a298c73 |
167 | Aran Clary Deltac <bluefeet@cpan.org> |
7a76f44c |
168 | |
169 | =head1 LICENSE |
170 | |
171 | You may distribute this code under the same terms as Perl itself. |
172 | |