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 | |
133dd22a |
59 | =head1 AUTO UPDATE |
60 | |
61 | All of the move_* methods automatically update the rows involved in |
62 | the query. This is not configurable and is due to the fact that if you |
63 | move a record it always causes other records in the list to be updated. |
64 | |
118e6b96 |
65 | =head1 METHODS |
66 | |
67 | =head2 position_column |
68 | |
69 | __PACKAGE__->position_column('position'); |
70 | |
71 | Sets and retrieves the name of the column that stores the |
72 | positional value of each record. Default to "position". |
73 | |
74 | =cut |
75 | |
76 | __PACKAGE__->mk_classdata( 'position_column' => 'position' ); |
77 | |
133dd22a |
78 | =head2 collection_column |
79 | |
80 | __PACKAGE__->collection_column('thing_id'); |
81 | |
82 | This method specified a column to limit all queries in |
83 | this module by. This effectively allows you to have multiple |
84 | positioned lists within the same table. |
85 | |
86 | =cut |
87 | |
88 | __PACKAGE__->mk_classdata( 'collection_column' ); |
89 | |
118e6b96 |
90 | =head2 siblings |
91 | |
92 | my $rs = $employee->siblings(); |
93 | my @siblings = $employee->siblings(); |
94 | |
95 | Returns either a result set or an array of all other objects |
96 | excluding the one you called it on. |
97 | |
98 | =cut |
99 | |
100 | sub siblings { |
101 | my( $self ) = @_; |
102 | my $position_column = $self->position_column; |
a9cdbec2 |
103 | my $rs = $self->result_source->resultset->search( |
7a76f44c |
104 | { |
105 | $position_column => { '!=' => $self->get_column($position_column) }, |
133dd22a |
106 | $self->_collection_clause(), |
7a76f44c |
107 | }, |
118e6b96 |
108 | { order_by => $self->position_column }, |
109 | ); |
7a76f44c |
110 | return $rs->all() if (wantarray()); |
111 | return $rs; |
118e6b96 |
112 | } |
113 | |
114 | =head2 first_sibling |
115 | |
116 | my $sibling = $employee->first_sibling(); |
117 | |
5faa95af |
118 | Returns the first sibling object, or 0 if the first sibling |
119 | is this sibliing. |
118e6b96 |
120 | |
121 | =cut |
122 | |
123 | sub first_sibling { |
124 | my( $self ) = @_; |
5faa95af |
125 | return 0 if ($self->get_column($self->position_column())==1); |
a9cdbec2 |
126 | return ($self->result_source->resultset->search( |
127 | { |
128 | $self->position_column => 1, |
129 | $self->_collection_clause(), |
130 | }, |
118e6b96 |
131 | )->all())[0]; |
132 | } |
133 | |
134 | =head2 last_sibling |
135 | |
136 | my $sibling = $employee->last_sibling(); |
137 | |
5faa95af |
138 | Return the last sibling, or 0 if the last sibling is this |
139 | sibling. |
118e6b96 |
140 | |
141 | =cut |
142 | |
143 | sub last_sibling { |
144 | my( $self ) = @_; |
a9cdbec2 |
145 | my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count(); |
5faa95af |
146 | return 0 if ($self->get_column($self->position_column())==$count); |
a9cdbec2 |
147 | return ($self->result_source->resultset->search( |
148 | { |
149 | $self->position_column => $count, |
150 | $self->_collection_clause(), |
151 | }, |
118e6b96 |
152 | )->all())[0]; |
153 | } |
154 | |
155 | =head2 previous_sibling |
156 | |
157 | my $sibling = $employee->previous_sibling(); |
158 | |
159 | Returns the sibling that resides one position higher. Undef |
160 | is returned if the current object is the first one. |
161 | |
162 | =cut |
163 | |
164 | sub previous_sibling { |
165 | my( $self ) = @_; |
166 | my $position_column = $self->position_column; |
707cbb2d |
167 | my $position = $self->get_column( $position_column ); |
168 | return 0 if ($position==1); |
3ffca97b |
169 | return ($self->result_source->resultset->search( |
7a76f44c |
170 | { |
707cbb2d |
171 | $position_column => $position - 1, |
133dd22a |
172 | $self->_collection_clause(), |
707cbb2d |
173 | } |
118e6b96 |
174 | )->all())[0]; |
175 | } |
176 | |
177 | =head2 next_sibling |
178 | |
179 | my $sibling = $employee->next_sibling(); |
180 | |
181 | Returns the sibling that resides one position lower. Undef |
182 | is returned if the current object is the last one. |
183 | |
184 | =cut |
185 | |
186 | sub next_sibling { |
187 | my( $self ) = @_; |
188 | my $position_column = $self->position_column; |
707cbb2d |
189 | my $position = $self->get_column( $position_column ); |
190 | my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count(); |
191 | return 0 if ($position==$count); |
133dd22a |
192 | return ($self->result_source->resultset->search( |
7a76f44c |
193 | { |
707cbb2d |
194 | $position_column => $position + 1, |
133dd22a |
195 | $self->_collection_clause(), |
7a76f44c |
196 | }, |
118e6b96 |
197 | )->all())[0]; |
198 | } |
199 | |
80010e2b |
200 | =head2 move_previous |
118e6b96 |
201 | |
80010e2b |
202 | $employee->move_previous(); |
118e6b96 |
203 | |
80010e2b |
204 | Swaps position with the sibling on position previous in the list. |
205 | 1 is returned on success, and 0 is returned if the objects is already |
206 | the first one. |
118e6b96 |
207 | |
208 | =cut |
209 | |
80010e2b |
210 | sub move_previous { |
118e6b96 |
211 | my( $self ) = @_; |
133dd22a |
212 | my $position = $self->get_column( $self->position_column() ); |
213 | return $self->move_to( $position - 1 ); |
118e6b96 |
214 | } |
215 | |
80010e2b |
216 | =head2 move_next |
118e6b96 |
217 | |
80010e2b |
218 | $employee->move_next(); |
118e6b96 |
219 | |
80010e2b |
220 | Swaps position with the sibling in the next position. 1 is returned on |
221 | success, and 0 is returned if the object is already the last in the list. |
118e6b96 |
222 | |
223 | =cut |
224 | |
80010e2b |
225 | sub move_next { |
118e6b96 |
226 | my( $self ) = @_; |
133dd22a |
227 | my $position = $self->get_column( $self->position_column() ); |
228 | my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count(); |
229 | return 0 if ($position==$count); |
230 | return $self->move_to( $position + 1 ); |
118e6b96 |
231 | } |
232 | |
233 | =head2 move_first |
234 | |
235 | $employee->move_first(); |
236 | |
237 | Moves the object to the first position. 1 is returned on |
238 | success, and 0 is returned if the object is already the first. |
239 | |
240 | =cut |
241 | |
242 | sub move_first { |
243 | my( $self ) = @_; |
244 | return $self->move_to( 1 ); |
245 | } |
246 | |
247 | =head2 move_last |
248 | |
249 | $employee->move_last(); |
250 | |
251 | Moves the object to the very last position. 1 is returned on |
252 | success, and 0 is returned if the object is already the last one. |
253 | |
254 | =cut |
255 | |
256 | sub move_last { |
257 | my( $self ) = @_; |
133dd22a |
258 | my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count(); |
118e6b96 |
259 | return $self->move_to( $count ); |
260 | } |
261 | |
262 | =head2 move_to |
263 | |
264 | $employee->move_to( $position ); |
265 | |
266 | Moves the object to the specified position. 1 is returned on |
267 | success, and 0 is returned if the object is already at the |
268 | specified position. |
269 | |
270 | =cut |
271 | |
272 | sub move_to { |
273 | my( $self, $to_position ) = @_; |
274 | my $position_column = $self->position_column; |
275 | my $from_position = $self->get_column( $position_column ); |
133dd22a |
276 | return 0 if ( $to_position < 1 ); |
277 | return 0 if ( $from_position==$to_position ); |
278 | my $rs = $self->result_source->resultset->search({ |
118e6b96 |
279 | -and => [ |
280 | $position_column => { ($from_position>$to_position?'<':'>') => $from_position }, |
281 | $position_column => { ($from_position>$to_position?'>=':'<=') => $to_position }, |
7a76f44c |
282 | ], |
133dd22a |
283 | $self->_collection_clause(), |
118e6b96 |
284 | }); |
285 | my $op = ($from_position>$to_position) ? '+' : '-'; |
286 | $rs->update({ |
287 | $position_column => \"$position_column $op 1", |
288 | }); |
289 | $self->set_column( $position_column => $to_position ); |
290 | $self->update(); |
291 | return 1; |
292 | } |
293 | |
294 | =head2 insert |
295 | |
296 | Overrides the DBIC insert() method by providing a default |
297 | position number. The default will be the number of rows in |
298 | the table +1, thus positioning the new record at the last position. |
299 | |
300 | =cut |
301 | |
302 | sub insert { |
303 | my $self = shift; |
304 | my $position_column = $self->position_column; |
133dd22a |
305 | $self->set_column( $position_column => $self->result_source->resultset->search( {$self->_collection_clause()} )->count()+1 ) |
118e6b96 |
306 | if (!$self->get_column($position_column)); |
307 | $self->next::method( @_ ); |
308 | } |
309 | |
310 | =head2 delete |
311 | |
312 | Overrides the DBIC delete() method by first moving the object |
313 | to the last position, then deleting it, thus ensuring the |
314 | integrity of the positions. |
315 | |
316 | =cut |
317 | |
318 | sub delete { |
319 | my $self = shift; |
320 | $self->move_last; |
321 | $self->next::method( @_ ); |
322 | } |
323 | |
7a76f44c |
324 | =head1 PRIVATE METHODS |
325 | |
326 | These methods are used internally. You should never have the |
327 | need to use them. |
328 | |
133dd22a |
329 | =head2 _collection_clause |
118e6b96 |
330 | |
133dd22a |
331 | This method returns a name=>value pare for limiting a search |
332 | by the collection column. If the collection column is not |
333 | defined then this will return an empty list. |
118e6b96 |
334 | |
7a76f44c |
335 | =cut |
336 | |
133dd22a |
337 | sub _collection_clause { |
338 | my $self = shift; |
339 | if ($self->collection_column()) { |
340 | return ( $self->collection_column() => $self->get_column($self->collection_column()) ); |
341 | } |
7a76f44c |
342 | return (); |
343 | } |
344 | |
345 | 1; |
346 | __END__ |
118e6b96 |
347 | |
348 | =head1 BUGS |
349 | |
133dd22a |
350 | =head2 Race Condition on Insert |
351 | |
118e6b96 |
352 | If a position is not specified for an insert than a position |
353 | will be chosen based on COUNT(*)+1. But, it first selects the |
354 | count then inserts the record. The space of time between select |
355 | and insert introduces a race condition. To fix this we need the |
356 | ability to lock tables in DBIC. I've added an entry in the TODO |
357 | about this. |
358 | |
133dd22a |
359 | =head2 Multiple Moves |
360 | |
361 | Be careful when issueing move_* methods to multiple objects. If |
362 | you've pre-loaded the objects then when you move one of the objects |
363 | the position of the other object will not reflect their new value |
364 | until you reload them from the database. |
365 | |
366 | The are times when you will want to move objects as groups, such |
367 | as changeing the parent of several objects at once - this directly |
368 | conflicts with this problem. One solution is for us to write a |
369 | ResultSet class that supports a parent() method, for example. Another |
370 | solution is to somehow automagically modify the objects that exist |
371 | in the current object's result set to have the new position value. |
372 | |
118e6b96 |
373 | =head1 AUTHOR |
374 | |
375 | Aran Deltac <bluefeet@cpan.org> |
376 | |
377 | =head1 LICENSE |
378 | |
379 | You may distribute this code under the same terms as Perl itself. |
380 | |