Commit | Line | Data |
118e6b96 |
1 | # vim: ts=8:sw=4:sts=4:et |
2 | package DBIx::Class::Positioned; |
3 | use strict; |
4 | use warnings; |
5 | use base qw( DBIx::Class ); |
6 | |
7 | =head1 NAME |
8 | |
9 | DBIx::Class::Positioned - Modify the position of objects in an ordered list. |
10 | |
11 | =head1 SYNOPSIS |
12 | |
13 | Create a table for your positionable data. |
14 | |
15 | CREATE TABLE employees ( |
16 | employee_id INTEGER PRIMARY KEY AUTOINCREMENT, |
17 | name TEXT NOT NULL, |
18 | position INTEGER NOT NULL |
19 | ); |
20 | |
21 | In your Schema or DB class add Positioned to the top |
22 | of the component list. |
23 | |
24 | __PACKAGE__->load_components(qw( Positioned ... )); |
25 | |
26 | Specify the column that stores the position number for |
27 | each row. |
28 | |
29 | package My::Employee; |
30 | __PACKAGE__->position_column('position'); |
31 | |
32 | Thats it, now you can change the position of your objects. |
33 | |
34 | #!/use/bin/perl |
35 | use My::Employee; |
36 | |
37 | my $employee = My::Employee->create({ name=>'Matt S. Trout' }); |
38 | |
39 | my $rs = $employee->siblings(); |
40 | my @siblings = $employee->siblings(); |
41 | |
42 | my $sibling; |
43 | $sibling = $employee->first_sibling(); |
44 | $sibling = $employee->last_sibling(); |
45 | $sibling = $employee->previous_sibling(); |
46 | $sibling = $employee->next_sibling(); |
47 | |
48 | $employee->move_previous(); |
49 | $employee->move_next(); |
50 | $employee->move_first(); |
51 | $employee->move_last(); |
52 | $employee->move_to( $position ); |
53 | |
54 | =head1 DESCRIPTION |
55 | |
56 | This module provides a simple interface for modifying the position |
57 | of DBIx::Class objects. |
58 | |
59 | =head1 METHODS |
60 | |
61 | =head2 position_column |
62 | |
63 | __PACKAGE__->position_column('position'); |
64 | |
65 | Sets and retrieves the name of the column that stores the |
66 | positional value of each record. Default to "position". |
67 | |
68 | =cut |
69 | |
70 | __PACKAGE__->mk_classdata( 'position_column' => 'position' ); |
71 | |
72 | =head2 siblings |
73 | |
74 | my $rs = $employee->siblings(); |
75 | my @siblings = $employee->siblings(); |
76 | |
77 | Returns either a result set or an array of all other objects |
78 | excluding the one you called it on. |
79 | |
80 | =cut |
81 | |
82 | sub siblings { |
83 | my( $self ) = @_; |
84 | my $position_column = $self->position_column; |
85 | my $rs = $self->search( |
7a76f44c |
86 | { |
87 | $position_column => { '!=' => $self->get_column($position_column) }, |
88 | $self->_parent_clause(), |
89 | }, |
118e6b96 |
90 | { order_by => $self->position_column }, |
91 | ); |
7a76f44c |
92 | return $rs->all() if (wantarray()); |
93 | return $rs; |
118e6b96 |
94 | } |
95 | |
96 | =head2 first_sibling |
97 | |
98 | my $sibling = $employee->first_sibling(); |
99 | |
100 | Returns the first sibling object. |
101 | |
102 | =cut |
103 | |
104 | sub first_sibling { |
105 | my( $self ) = @_; |
106 | return ($self->search( |
7a76f44c |
107 | { $self->_parent_clause() }, |
118e6b96 |
108 | { rows=>1, order_by => $self->position_column }, |
109 | )->all())[0]; |
110 | } |
111 | |
112 | =head2 last_sibling |
113 | |
114 | my $sibling = $employee->last_sibling(); |
115 | |
116 | Return the last sibling. |
117 | |
118 | =cut |
119 | |
120 | sub last_sibling { |
121 | my( $self ) = @_; |
122 | return ($self->search( |
7a76f44c |
123 | { $self->_parent_clause() }, |
118e6b96 |
124 | { rows=>1, order_by => $self->position_column.' DESC' }, |
125 | )->all())[0]; |
126 | } |
127 | |
128 | =head2 previous_sibling |
129 | |
130 | my $sibling = $employee->previous_sibling(); |
131 | |
132 | Returns the sibling that resides one position higher. Undef |
133 | is returned if the current object is the first one. |
134 | |
135 | =cut |
136 | |
137 | sub previous_sibling { |
138 | my( $self ) = @_; |
139 | my $position_column = $self->position_column; |
140 | return ($self->search( |
7a76f44c |
141 | { |
142 | $position_column => { '<' => $self->get_column($position_column) }, |
143 | $self->_parent_clause(), |
144 | }, |
118e6b96 |
145 | { rows=>1, order_by => $position_column.' DESC' }, |
146 | )->all())[0]; |
147 | } |
148 | |
149 | =head2 next_sibling |
150 | |
151 | my $sibling = $employee->next_sibling(); |
152 | |
153 | Returns the sibling that resides one position lower. Undef |
154 | is returned if the current object is the last one. |
155 | |
156 | =cut |
157 | |
158 | sub next_sibling { |
159 | my( $self ) = @_; |
160 | my $position_column = $self->position_column; |
161 | return ($self->search( |
7a76f44c |
162 | { |
163 | $position_column => { '>' => $self->get_column($position_column) }, |
164 | $self->_parent_clause(), |
165 | }, |
118e6b96 |
166 | { rows=>1, order_by => $position_column }, |
167 | )->all())[0]; |
168 | } |
169 | |
80010e2b |
170 | =head2 move_previous |
118e6b96 |
171 | |
80010e2b |
172 | $employee->move_previous(); |
118e6b96 |
173 | |
80010e2b |
174 | Swaps position with the sibling on position previous in the list. |
175 | 1 is returned on success, and 0 is returned if the objects is already |
176 | the first one. |
118e6b96 |
177 | |
178 | =cut |
179 | |
80010e2b |
180 | sub move_previous { |
118e6b96 |
181 | my( $self ) = @_; |
182 | my $previous = $self->previous_sibling(); |
183 | return undef if (!$previous); |
184 | my $position_column = $self->position_column; |
185 | my $self_position = $self->get_column( $position_column ); |
186 | $self->set_column( $position_column, $previous->get_column($position_column) ); |
187 | $previous->set_column( $position_column, $self_position ); |
188 | $self->update(); |
189 | $previous->update(); |
190 | return 1; |
191 | } |
192 | |
80010e2b |
193 | =head2 move_next |
118e6b96 |
194 | |
80010e2b |
195 | $employee->move_next(); |
118e6b96 |
196 | |
80010e2b |
197 | Swaps position with the sibling in the next position. 1 is returned on |
198 | success, and 0 is returned if the object is already the last in the list. |
118e6b96 |
199 | |
200 | =cut |
201 | |
80010e2b |
202 | sub move_next { |
118e6b96 |
203 | my( $self ) = @_; |
204 | my $next = $self->next_sibling(); |
205 | return undef if (!$next); |
206 | my $position_column = $self->position_column; |
207 | my $self_position = $self->get_column( $position_column ); |
208 | $self->set_column( $position_column, $next->get_column($position_column) ); |
209 | $next->set_column( $position_column, $self_position ); |
210 | $self->update(); |
211 | $next->update(); |
212 | return 1; |
213 | } |
214 | |
215 | =head2 move_first |
216 | |
217 | $employee->move_first(); |
218 | |
219 | Moves the object to the first position. 1 is returned on |
220 | success, and 0 is returned if the object is already the first. |
221 | |
222 | =cut |
223 | |
224 | sub move_first { |
225 | my( $self ) = @_; |
226 | return $self->move_to( 1 ); |
227 | } |
228 | |
229 | =head2 move_last |
230 | |
231 | $employee->move_last(); |
232 | |
233 | Moves the object to the very last position. 1 is returned on |
234 | success, and 0 is returned if the object is already the last one. |
235 | |
236 | =cut |
237 | |
238 | sub move_last { |
239 | my( $self ) = @_; |
7a76f44c |
240 | my $count = $self->search({$self->_parent_clause()})->count(); |
118e6b96 |
241 | return $self->move_to( $count ); |
242 | } |
243 | |
244 | =head2 move_to |
245 | |
246 | $employee->move_to( $position ); |
247 | |
248 | Moves the object to the specified position. 1 is returned on |
249 | success, and 0 is returned if the object is already at the |
250 | specified position. |
251 | |
252 | =cut |
253 | |
254 | sub move_to { |
255 | my( $self, $to_position ) = @_; |
256 | my $position_column = $self->position_column; |
257 | my $from_position = $self->get_column( $position_column ); |
258 | return undef if ( $from_position==$to_position ); |
259 | my $rs = $self->search({ |
260 | -and => [ |
261 | $position_column => { ($from_position>$to_position?'<':'>') => $from_position }, |
262 | $position_column => { ($from_position>$to_position?'>=':'<=') => $to_position }, |
7a76f44c |
263 | ], |
264 | $self->_parent_clause(), |
118e6b96 |
265 | }); |
266 | my $op = ($from_position>$to_position) ? '+' : '-'; |
267 | $rs->update({ |
268 | $position_column => \"$position_column $op 1", |
269 | }); |
270 | $self->set_column( $position_column => $to_position ); |
271 | $self->update(); |
272 | return 1; |
273 | } |
274 | |
275 | =head2 insert |
276 | |
277 | Overrides the DBIC insert() method by providing a default |
278 | position number. The default will be the number of rows in |
279 | the table +1, thus positioning the new record at the last position. |
280 | |
281 | =cut |
282 | |
283 | sub insert { |
284 | my $self = shift; |
285 | my $position_column = $self->position_column; |
7a76f44c |
286 | $self->set_column( $position_column => $self->search( {$self->_parent_clause()} )->count()+1 ) |
118e6b96 |
287 | if (!$self->get_column($position_column)); |
288 | $self->next::method( @_ ); |
289 | } |
290 | |
291 | =head2 delete |
292 | |
293 | Overrides the DBIC delete() method by first moving the object |
294 | to the last position, then deleting it, thus ensuring the |
295 | integrity of the positions. |
296 | |
297 | =cut |
298 | |
299 | sub delete { |
300 | my $self = shift; |
301 | $self->move_last; |
302 | $self->next::method( @_ ); |
303 | } |
304 | |
7a76f44c |
305 | =head1 PRIVATE METHODS |
306 | |
307 | These methods are used internally. You should never have the |
308 | need to use them. |
309 | |
310 | =head2 _parent_clause |
311 | |
312 | sub _parent_clause { |
313 | my( $self ) = @_; |
314 | return ( parent_id => $self->parent_id ); |
315 | } |
118e6b96 |
316 | |
7a76f44c |
317 | This method is a placeholder for you, or another component, to |
318 | provide additional limits for all the various queries in this |
319 | module. This allows for more than one positionable list within |
320 | the same table since any move_* method will adhere to the clause |
321 | that you specify. |
118e6b96 |
322 | |
7a76f44c |
323 | =cut |
324 | |
325 | sub _parent_clause { |
326 | return (); |
327 | } |
328 | |
329 | 1; |
330 | __END__ |
118e6b96 |
331 | |
332 | =head1 BUGS |
333 | |
334 | If a position is not specified for an insert than a position |
335 | will be chosen based on COUNT(*)+1. But, it first selects the |
336 | count then inserts the record. The space of time between select |
337 | and insert introduces a race condition. To fix this we need the |
338 | ability to lock tables in DBIC. I've added an entry in the TODO |
339 | about this. |
340 | |
341 | =head1 AUTHOR |
342 | |
343 | Aran Deltac <bluefeet@cpan.org> |
344 | |
345 | =head1 LICENSE |
346 | |
347 | You may distribute this code under the same terms as Perl itself. |
348 | |