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)) { |
86 | $new_parent = $new_parent->id() || 0; |
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( |
92 | $self->position_column() => $self->search( {$self->_collection_clause()} )->count() + 1 |
93 | ); |
94 | $self->update(); |
95 | return 1; |
96 | } |
97 | else { |
98 | return $self->next::method(); |
99 | } |
100 | } |
101 | |
102 | =head2 children |
103 | |
104 | my $children_rs = $employee->children(); |
105 | my @children = $employee->children(); |
106 | |
107 | This method works just like it does in the |
108 | DBIx::Class::Tree::AdjacencyList module except it |
109 | orders the children by there position. |
110 | |
111 | =cut |
112 | |
113 | sub children { |
114 | my( $self ) = @_; |
115 | my $rs = $self->search( |
116 | { $self->parent_column() => $self->id() }, |
117 | { order_by => $self->position_column() } |
118 | ); |
119 | return $rs->all() if (wantarray()); |
120 | return $rs; |
121 | } |
122 | |
123 | =head2 append_child |
124 | |
125 | $parent->append_child( $child ); |
126 | |
127 | Sets the child to have the specified parent and moves the |
128 | child to the last position. |
129 | |
130 | =cut |
131 | |
132 | sub append_child { |
133 | my( $self, $child ) = @_; |
134 | $child->parent( $self ); |
135 | } |
136 | |
137 | =head2 prepend_child |
138 | |
139 | $parent->prepend_child( $child ); |
140 | |
141 | Sets the child to have the specified parent and moves the |
142 | child to the first position. |
143 | |
144 | =cut |
145 | |
146 | sub prepend_child { |
147 | my( $self, $child ) = @_; |
148 | $child->parent( $self ); |
149 | $child->move_first(); |
150 | } |
151 | |
152 | =head2 attach_before |
153 | |
154 | $this->attach_before( $that ); |
155 | |
156 | Attaches the object at the position just before the |
157 | calling object's position. |
158 | |
159 | =cut |
160 | |
161 | sub attach_before { |
162 | my( $self, $sibling ) = @_; |
163 | $sibling->parent( $self->parent() ); |
164 | $sibling->move_to( $self->get_column($self->position_column()) ); |
165 | } |
166 | |
167 | =head2 attach_after |
168 | |
169 | $this->attach_after( $that ); |
170 | |
171 | Attaches the object at the position just after the |
172 | calling object's position. |
173 | |
174 | =cut |
175 | |
176 | sub attach_after { |
177 | my( $self, $sibling ) = @_; |
178 | $sibling->parent( $self->parent() ); |
179 | $sibling->move_to( $self->get_column($self->position_column()) + 1 ); |
180 | } |
181 | |
182 | =head1 PRIVATE METHODS |
183 | |
184 | These methods are used internally. You should never have the |
185 | need to use them. |
186 | |
187 | =head2 _collection_clause |
188 | |
189 | This method is provided as an override of the method in |
190 | L<DBIx::Class::Positional>. This method is what provides the |
191 | glue between AdjacencyList and Positional. |
192 | |
193 | =cut |
194 | |
195 | sub _collection_clause { |
196 | my( $self ) = @_; |
197 | return ( |
198 | $self->parent_column() => |
199 | $self->get_column($self->parent_column()) |
200 | ); |
201 | } |
202 | |
203 | 1; |
204 | __END__ |
205 | |
206 | =head1 AUTHOR |
207 | |
208 | Aran Clary Deltac <bluefeet@cpan.org> |
209 | |
210 | =head1 LICENSE |
211 | |
212 | You may distribute this code under the same terms as Perl itself. |
213 | |