Commit | Line | Data |
57f04bd5 |
1 | # vim: ts=8:sw=4:sts=4:et |
2 | package DBIx::Class::Tree::AdjacencyList::Positional; |
3 | use strict; |
4 | use warnings; |
5 | use base qw( DBIx::Class ); |
6 | use Carp qw( croak ); |
7 | |
8 | __PACKAGE__->load_components(qw( |
9 | Tree::AdjacencyList |
10 | Positional |
11 | )); |
12 | |
13 | =head1 NAME |
14 | |
15 | DBIx::Class::Tree::AdjacencyList::Positional - Glue DBIx::Class::Positional and DBIx::Class::Tree::AdjacencyList together. (EXPERIMENTAL) |
16 | |
17 | =head1 SYNOPSIS |
18 | |
19 | Create a table for your tree data. |
20 | |
21 | CREATE TABLE employees ( |
22 | employee_id INTEGER PRIMARY KEY AUTOINCREMENT, |
23 | parent_id INTEGER NOT NULL, |
24 | position INTEGER NOT NULL, |
25 | name TEXT NOT NULL |
26 | ); |
27 | |
28 | In your Schema or DB class add Tree::AdjacencyList::Positional |
29 | to the top of the component list. |
30 | |
31 | __PACKAGE__->load_components(qw( Tree::AdjacencyList::Positional ... )); |
32 | |
33 | Specify the column that contains the parent ID and position of each row. |
34 | |
35 | package My::Employee; |
36 | __PACKAGE__->parent_column('parent_id'); |
37 | __PACAKGE__->position_column('position'); |
38 | |
39 | This module provides a few extra methods beyond what |
40 | L<DBIx::Class::Positional> and L<DBIx::Class::Tree::AdjacencyList> |
41 | already provide. |
42 | |
43 | my $parent = $employee->parent(); |
44 | $employee->parent( $parent_obj ); |
45 | $employee->parent( $parent_id ); |
46 | |
47 | my $children_rs = $employee->children(); |
48 | my @children = $employee->children(); |
49 | |
50 | $parent->append_child( $child ); |
51 | $parent->prepend_child( $child ); |
52 | |
53 | $this->attach_before( $that ); |
54 | $this->attach_after( $that ); |
55 | |
56 | =head1 DESCRIPTION |
57 | |
58 | This module provides methods for working with adjacency lists and positional |
59 | rows. All of the methods that L<DBIx::Class::Positional> and |
60 | L<DBIx::Class::Tree::AdjacencyList> provide are available with this module. |
61 | If you |
62 | |
63 | =head1 METHODS |
64 | |
65 | =head2 parent |
66 | |
67 | my $parent = $employee->parent(); |
68 | $employee->parent( $parent_obj ); |
69 | $employee->parent( $parent_id ); |
70 | |
71 | my $children_rs = $employee->children(); |
72 | my @children = $employee->children(); |
73 | |
74 | This method works exactly like it does in the |
75 | DBIx::Class::Tree::AdjacencyList module except that it will |
76 | first move the object to the last position of the list, change |
77 | the parent ID, then move the object to the last position of |
78 | the new list. This ensures the intergrity of the positions. |
79 | |
80 | =cut |
81 | |
82 | sub parent { |
83 | my( $self, $new_parent ) = @_; |
84 | if ($new_parent) { |
85 | if (ref($new_parent)) { |
e338251b |
86 | $new_parent = $new_parent->id() || croak('Parent object does not have an id'); |
57f04bd5 |
87 | } |
88 | return 0 if ($new_parent == ($self->get_column($self->parent_column())||0)); |
89 | $self->move_last(); |
90 | return 0 if (!$self->next::method( $new_parent )); |
91 | $self->set_column( |
e338251b |
92 | $self->position_column() => |
93 | $self->result_source->resultset->search( |
94 | {$self->_collection_clause()} |
95 | )->count() + 1 |
57f04bd5 |
96 | ); |
97 | $self->update(); |
98 | return 1; |
99 | } |
100 | else { |
101 | return $self->next::method(); |
102 | } |
103 | } |
104 | |
105 | =head2 children |
106 | |
107 | my $children_rs = $employee->children(); |
108 | my @children = $employee->children(); |
109 | |
110 | This method works just like it does in the |
111 | DBIx::Class::Tree::AdjacencyList module except it |
112 | orders the children by there position. |
113 | |
114 | =cut |
115 | |
116 | sub children { |
117 | my( $self ) = @_; |
e338251b |
118 | my $rs = $self->result_source->resultset->search( |
57f04bd5 |
119 | { $self->parent_column() => $self->id() }, |
120 | { order_by => $self->position_column() } |
121 | ); |
122 | return $rs->all() if (wantarray()); |
123 | return $rs; |
124 | } |
125 | |
126 | =head2 append_child |
127 | |
128 | $parent->append_child( $child ); |
129 | |
130 | Sets the child to have the specified parent and moves the |
131 | child to the last position. |
132 | |
133 | =cut |
134 | |
135 | sub append_child { |
136 | my( $self, $child ) = @_; |
137 | $child->parent( $self ); |
138 | } |
139 | |
140 | =head2 prepend_child |
141 | |
142 | $parent->prepend_child( $child ); |
143 | |
144 | Sets the child to have the specified parent and moves the |
145 | child to the first position. |
146 | |
147 | =cut |
148 | |
149 | sub prepend_child { |
150 | my( $self, $child ) = @_; |
151 | $child->parent( $self ); |
152 | $child->move_first(); |
153 | } |
154 | |
155 | =head2 attach_before |
156 | |
157 | $this->attach_before( $that ); |
158 | |
159 | Attaches the object at the position just before the |
160 | calling object's position. |
161 | |
162 | =cut |
163 | |
164 | sub attach_before { |
165 | my( $self, $sibling ) = @_; |
166 | $sibling->parent( $self->parent() ); |
167 | $sibling->move_to( $self->get_column($self->position_column()) ); |
168 | } |
169 | |
170 | =head2 attach_after |
171 | |
172 | $this->attach_after( $that ); |
173 | |
174 | Attaches the object at the position just after the |
175 | calling object's position. |
176 | |
177 | =cut |
178 | |
179 | sub attach_after { |
180 | my( $self, $sibling ) = @_; |
181 | $sibling->parent( $self->parent() ); |
182 | $sibling->move_to( $self->get_column($self->position_column()) + 1 ); |
183 | } |
184 | |
185 | =head1 PRIVATE METHODS |
186 | |
187 | These methods are used internally. You should never have the |
188 | need to use them. |
189 | |
e338251b |
190 | =head2 collection_column |
191 | |
192 | Postional's collection_column method does not, and should not, be |
193 | defined when using this module. This method just throws out an |
194 | error if you try to use it. |
195 | |
196 | =cut |
197 | |
198 | sub collection_column { |
199 | croak('Use parent_column() instead of collection_column()'); |
200 | } |
201 | |
57f04bd5 |
202 | =head2 _collection_clause |
203 | |
204 | This method is provided as an override of the method in |
205 | L<DBIx::Class::Positional>. This method is what provides the |
206 | glue between AdjacencyList and Positional. |
207 | |
208 | =cut |
209 | |
210 | sub _collection_clause { |
211 | my( $self ) = @_; |
212 | return ( |
213 | $self->parent_column() => |
214 | $self->get_column($self->parent_column()) |
215 | ); |
216 | } |
217 | |
218 | 1; |
219 | __END__ |
220 | |
221 | =head1 AUTHOR |
222 | |
223 | Aran Clary Deltac <bluefeet@cpan.org> |
224 | |
225 | =head1 LICENSE |
226 | |
227 | You may distribute this code under the same terms as Perl itself. |
228 | |