1 package SL::DB::Helper::ActsAsList;
5 use parent qw(Exporter);
6 our @EXPORT = qw(move_position_up move_position_down add_to_list remove_from_list reorder_list configure_acts_as_list
7 get_previous_in_list get_next_in_list get_full_list);
14 my ($class, @params) = @_;
15 my $importing = caller();
17 $importing->before_save( sub { SL::DB::Helper::ActsAsList::set_position(@_) });
18 $importing->before_delete(sub { SL::DB::Helper::ActsAsList::remove_position(@_) });
20 # Use 'goto' so that Exporter knows which module to import into via
22 goto &Exporter::import;
29 sub move_position_up {
34 sub move_position_down {
36 do_move($self, 'down');
39 sub remove_from_list {
43 remove_position($self);
45 # Set to -1 manually because $self->update_attributes() would
46 # trigger the before_save() hook from this very plugin assigning a
47 # number at the end of the list again.
48 my $table = $self->meta->table;
49 my $column = column_name($self);
50 my $primary_key_col = ($self->meta->primary_key)[0];
54 WHERE ${primary_key_col} = ?
56 $self->db->dbh->do($sql, undef, $self->$primary_key_col);
57 $self->$column(undef);
60 return $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker);
64 my ($self, %params) = @_;
66 croak "Invalid parameter 'position'" unless ($params{position} || '') =~ m/^ (?: before | after | first | last ) $/x;
68 if ($params{position} eq 'last') {
74 my $table = $self->meta->table;
75 my $primary_key_col = ($self->meta->primary_key)[0];
76 my $column = column_name($self);
77 my ($group_by, @values) = get_group_by_where($self);
78 $group_by = " AND ${group_by}" if $group_by;
81 if ($params{position} eq 'first') {
85 # Can only be 'before' or 'after' -- 'last' has been checked above
88 my $reference = $params{reference};
89 croak "Missing parameter 'reference'" if !$reference;
93 $reference_pos = $reference->$column;
95 ($reference_pos) = $self->db->dbh->selectrow_array(qq|SELECT ${column} FROM ${table} WHERE ${primary_key_col} = ?|, undef, $reference);
98 $new_position = $params{position} eq 'before' ? $reference_pos : $reference_pos + 1;
103 SET ${column} = ${column} + 1
104 WHERE (${column} > ?)
109 $self->db->dbh->do($query, undef, $new_position - 1, @values);
110 $self->update_attributes($column => $new_position);
113 return $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker);
116 sub get_next_in_list {
118 return get_previous_or_next($self, 'next');
121 sub get_previous_in_list {
123 return get_previous_or_next($self, 'previous');
129 my $group_by = get_spec(ref $self, 'group_by') || [];
130 $group_by = [ $group_by ] if $group_by && !ref $group_by;
131 my @where = map { ($_ => $self->$_) } @{ $group_by };
133 return $self->_get_manager_class->get_all(where => \@where, sort_by => column_name($self) . ' ASC');
137 my ($class_or_self, @ids) = @_;
139 return 1 unless @ids;
141 my $self = ref($class_or_self) ? $class_or_self : $class_or_self->new;
142 my $column = column_name($self);
143 my $result = $self->db->do_transaction(sub {
144 my $query = qq|UPDATE | . $self->meta->table . qq| SET ${column} = ? WHERE id = ?|;
145 my $sth = $self->db->dbh->prepare($query) || die $self->db->dbh->errstr;
147 foreach my $new_position (1 .. scalar(@ids)) {
148 $sth->execute($new_position, $ids[$new_position - 1]) || die $sth->errstr;
157 sub configure_acts_as_list {
158 my ($class, %params) = @_;
160 $list_spec{$class} = {
161 group_by => $params{group_by},
162 column_name => $params{column_name},
170 sub get_group_by_where {
173 my $group_by = get_spec(ref $self, 'group_by') || [];
174 $group_by = [ $group_by ] if $group_by && !ref $group_by;
176 my (@where, @values);
177 foreach my $column (@{ $group_by }) {
178 my $value = $self->$column;
179 push @values, $value if defined $value;
180 push @where, defined($value) ? "(${column} = ?)" : "(${column} IS NULL)";
183 return (join(' AND ', @where), @values);
188 my $column = column_name($self);
189 my $value = $self->$column;
191 return 1 if defined($value) && ($value != -1);
193 my $table = $self->meta->table;
194 my ($group_by, @values) = get_group_by_where($self);
195 $group_by = " AND ${group_by}" if $group_by;
197 SELECT COALESCE(MAX(${column}), 0)
199 WHERE (${column} <> -1)
203 my $max_position = $self->db->dbh->selectrow_arrayref($sql, undef, @values)->[0];
204 $self->$column($max_position + 1);
209 sub remove_position {
211 my $column = column_name($self);
214 my $value = $self->$column;
215 return 1 unless defined($value) && ($value != -1);
217 my $table = $self->meta->table;
218 my ($group_by, @values) = get_group_by_where($self);
219 $group_by = ' AND ' . $group_by if $group_by;
222 SET ${column} = ${column} - 1
223 WHERE (${column} > ?)
227 $self->db->dbh->do($sql, undef, $value, @values);
233 my ($self, $direction) = @_;
235 croak "Object has not been saved yet" unless $self->id;
237 my $column = column_name($self);
238 my $old_position = $self->$column;
239 croak "No position set yet" unless defined($old_position) && ($old_position != -1);
241 my $table = $self->meta->table;
242 my ($comp_sel, $comp_upd, $min_max, $plus_minus) = $direction eq 'up' ? ('<', '>=', 'MAX', '+') : ('>', '<=', 'MIN', '-');
243 my ($group_by, @values) = get_group_by_where($self);
244 $group_by = ' AND ' . $group_by if $group_by;
246 SELECT ${min_max}(${column})
248 WHERE (${column} <> -1)
249 AND (${column} ${comp_sel} ?)
253 my $new_position = $self->db->dbh->selectrow_arrayref($sql, undef, $old_position, @values)->[0];
255 return undef unless defined $new_position;
260 WHERE (${column} = ?)
264 $self->db->dbh->do($sql, undef, $old_position, $new_position, @values);
266 $self->update_attributes($column => $new_position);
269 sub get_previous_or_next {
270 my ($self, $direction) = @_;
272 my $asc_desc = $direction eq 'next' ? 'ASC' : 'DESC';
273 my $comparator = $direction eq 'next' ? '>' : '<';
274 my $table = $self->meta->table;
275 my $column = column_name($self);
276 my $primary_key_col = ($self->meta->primary_key)[0];
277 my ($group_by, @values) = get_group_by_where($self);
278 $group_by = " AND ${group_by}" if $group_by;
280 SELECT ${primary_key_col}
282 WHERE (${column} ${comparator} ?)
284 ORDER BY ${column} ${asc_desc}
288 my $id = ($self->db->dbh->selectrow_arrayref($sql, undef, $self->$column, @values) || [])->[0];
290 return $id ? $self->_get_manager_class->find_by(id => $id) : undef;
295 my $column = get_spec(ref $self, 'column_name');
296 return $column if $column;
297 return $self->can('sortkey') ? 'sortkey' : 'position';
301 my ($class, $key) = @_;
303 return undef unless $list_spec{$class};
304 return $list_spec{$class}->{$key};
316 SL::DB::Helper::ActsAsList - Mixin for managing ordered items by a
321 package SL::DB::SomeObject;
322 use SL::DB::Helper::ActsAsList;
324 package SL::Controller::SomeController;
326 # Assign a position automatically
327 $obj = SL::DB::SomeObject->new(description => 'bla');
330 # Move items up and down
331 $obj = SL::DB::SomeOBject->new(id => 1)->load;
332 $obj->move_position_up;
333 $obj->move_position_down;
335 # Adjust all remaining positions automatically
338 This mixin assumes that the mixing package's table contains a column
339 called C<position> or C<sortkey> (for legacy tables). This column is
340 set automatically upon saving the object if it hasn't been set
341 already. If it hasn't then it will be set to the maximum position used
342 in the table plus one.
344 When the object is deleted all positions greater than the object's old
345 position are decreased by one.
347 The column name to use can be configured via L<configure_acts_as_list>.
349 =head1 CLASS FUNCTIONS
353 =item C<configure_acts_as_list %params>
355 Configures the mixin's behaviour. C<%params> can contain the following
362 The name of the column containing the position. If not set explicitly
363 then the mixin will use C<sortkey> if the model contains such a column
364 (only for legacy tables) and C<position> otherwise.
368 An optional column name (or array reference of column names) by which
369 to group. If a table contains items for several distinct sets and each
370 set has its own sorting then this can be used.
372 An example would be requirement spec text blocks. They have a column
373 called C<output_position> that selects where to output the text blocks
374 (either before or after the sections). Furthermore these text blocks
375 each belong to a single requirement spec document. So each combination
376 of C<requirement_spec_id> and C<output_position> should have its own
377 set of C<position> values, which can be achieved by configuring this
378 mixin with C<group_by = [qw(requirement_spec_id output_position)]>.
384 =head1 INSTANCE FUNCTIONS
388 =item C<move_position_up>
390 Swaps the object with the object one step above the current one
391 regarding their sort order by exchanging their C<position> values.
393 =item C<move_position_down>
395 Swaps the object with the object one step below the current one
396 regarding their sort order by exchanging their C<position> values.
398 =item C<add_to_list %params>
400 Adds this item to the list. The parameter C<position> is required and
401 can be one of C<first>, C<last>, C<before> and C<after>. With C<first>
402 the item is inserted as the first item in the list and all other
403 item's positions are shifted up by one. For C<position = last> the
404 item is inserted at the end of the list.
406 For C<before> and C<after> an additional parameter C<reference> is
407 required. This is either a Rose model instance or the primary key of
408 one. The current item will then be inserted either before or after the
409 referenced item by shifting all the appropriate item positions up by
412 After this function C<$self>'s positional column has been set and
413 saved to the database.
415 =item C<remove_from_list>
417 Sets this items positional column to C<-1>, saves it and moves all
418 following items up by 1.
420 =item C<get_previous_in_list>
422 Fetches the previous item in the list. Returns C<undef> if C<$self> is
423 already the first one.
425 =item C<get_next_in_list>
427 Fetches the next item in the list. Returns C<undef> if C<$self> is
428 already the last one.
430 =item C<get_full_list>
432 Fetches all items in the same list as C<$self> and returns them as an
435 =item C<reorder_list @ids>
437 Re-orders the objects given in C<@ids> by their position in C<@ids> by
438 updating all of their positional columns. Each element in
439 C<@positions> must be the ID of an object. The new position is the
440 ID's index inside C<@ids> plus one (meaning the first element's new
441 position will be 1 and not 0).
443 This works by executing SQL "UPDATE" statements directly.
445 Returns the result of the whole transaction (trueish in case of
448 This method can be called both as a class method or an instance
459 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>