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 configure_acts_as_list($importing, @params);
19 $importing->before_save( sub { SL::DB::Helper::ActsAsList::set_position(@_) });
20 $importing->before_delete(sub { SL::DB::Helper::ActsAsList::remove_position(@_) });
22 # Don't 'goto' to Exporters import, it would try to parse @params
23 __PACKAGE__->export_to_level(1, $class, @EXPORT);
30 sub move_position_up {
35 sub move_position_down {
37 do_move($self, 'down');
40 sub remove_from_list {
43 return $self->db->with_transaction(sub {
44 remove_position($self);
46 # Set to -1 manually because $self->update_attributes() would
47 # trigger the before_save() hook from this very plugin assigning a
48 # number at the end of the list again.
49 my $table = $self->meta->table;
50 my $column = column_name($self);
51 my $primary_key_col = ($self->meta->primary_key)[0];
55 WHERE ${primary_key_col} = ?
57 $self->db->dbh->do($sql, undef, $self->$primary_key_col);
58 $self->$column(undef);
63 my ($self, %params) = @_;
65 croak "Invalid parameter 'position'" unless ($params{position} || '') =~ m/^ (?: before | after | first | last ) $/x;
67 my $column = column_name($self);
69 $self->remove_from_list if ($self->$column // -1) != -1;
71 if ($params{position} eq 'last') {
77 my $table = $self->meta->table;
78 my $primary_key_col = ($self->meta->primary_key)[0];
79 my ($group_by, @values) = get_group_by_where($self);
80 $group_by = " AND ${group_by}" if $group_by;
83 if ($params{position} eq 'first') {
87 # Can only be 'before' or 'after' -- 'last' has been checked above
90 my $reference = $params{reference};
91 croak "Missing parameter 'reference'" if !$reference;
95 $reference_pos = $reference->$column;
97 ($reference_pos) = $self->db->dbh->selectrow_array(qq|SELECT ${column} FROM ${table} WHERE ${primary_key_col} = ?|, undef, $reference);
100 $new_position = $params{position} eq 'before' ? $reference_pos : $reference_pos + 1;
105 SET ${column} = ${column} + 1
106 WHERE (${column} > ?)
110 return $self->db->with_transaction(sub {
111 $self->db->dbh->do($query, undef, $new_position - 1, @values);
112 $self->update_attributes($column => $new_position);
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->with_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;
159 sub configure_acts_as_list {
160 my ($class, %params) = @_;
162 $list_spec{$class} = {
163 group_by => $params{group_by},
164 column_name => $params{column_name},
172 sub get_group_by_where {
175 my $group_by = get_spec(ref $self, 'group_by') || [];
176 $group_by = [ $group_by ] if $group_by && !ref $group_by;
178 my (@where, @values);
179 foreach my $column (@{ $group_by }) {
180 my $value = $self->$column;
181 push @values, $value if defined $value;
182 push @where, defined($value) ? "(${column} = ?)" : "(${column} IS NULL)";
185 return (join(' AND ', @where), @values);
190 my $column = column_name($self);
191 my $value = $self->$column;
193 return 1 if defined($value) && ($value != -1);
195 my $table = $self->meta->table;
196 my ($group_by, @values) = get_group_by_where($self);
197 $group_by = " AND ${group_by}" if $group_by;
199 SELECT COALESCE(MAX(${column}), 0)
201 WHERE (${column} <> -1)
205 my $max_position = $self->db->dbh->selectrow_arrayref($sql, undef, @values)->[0];
206 $self->$column($max_position + 1);
211 sub remove_position {
213 my $column = column_name($self);
216 my $value = $self->$column;
217 return 1 unless defined($value) && ($value != -1);
219 my $table = $self->meta->table;
220 my ($group_by, @values) = get_group_by_where($self);
221 $group_by = ' AND ' . $group_by if $group_by;
224 SET ${column} = ${column} - 1
225 WHERE (${column} > ?)
229 $self->db->dbh->do($sql, undef, $value, @values);
235 my ($self, $direction) = @_;
237 croak "Object has not been saved yet" unless $self->id;
239 my $column = column_name($self);
240 my $old_position = $self->$column;
241 croak "No position set yet" unless defined($old_position) && ($old_position != -1);
243 my $table = $self->meta->table;
244 my ($comp_sel, $comp_upd, $min_max, $plus_minus) = $direction eq 'up' ? ('<', '>=', 'MAX', '+') : ('>', '<=', 'MIN', '-');
245 my ($group_by, @values) = get_group_by_where($self);
246 $group_by = ' AND ' . $group_by if $group_by;
248 SELECT ${min_max}(${column})
250 WHERE (${column} <> -1)
251 AND (${column} ${comp_sel} ?)
255 my $new_position = $self->db->dbh->selectrow_arrayref($sql, undef, $old_position, @values)->[0];
257 return undef unless defined $new_position;
262 WHERE (${column} = ?)
266 $self->db->dbh->do($sql, undef, $old_position, $new_position, @values);
268 $self->update_attributes($column => $new_position);
271 sub get_previous_or_next {
272 my ($self, $direction) = @_;
274 my $asc_desc = $direction eq 'next' ? 'ASC' : 'DESC';
275 my $comparator = $direction eq 'next' ? '>' : '<';
276 my $table = $self->meta->table;
277 my $column = column_name($self);
278 my $primary_key_col = ($self->meta->primary_key)[0];
279 my ($group_by, @values) = get_group_by_where($self);
280 $group_by = " AND ${group_by}" if $group_by;
282 SELECT ${primary_key_col}
284 WHERE (${column} ${comparator} ?)
286 ORDER BY ${column} ${asc_desc}
290 my $id = ($self->db->dbh->selectrow_arrayref($sql, undef, $self->$column, @values) || [])->[0];
292 return $id ? $self->_get_manager_class->find_by(id => $id) : undef;
297 my $column = get_spec(ref $self, 'column_name');
298 return $column if $column;
299 return $self->can('sortkey') ? 'sortkey' : 'position';
303 my ($class, $key) = @_;
305 return undef unless $list_spec{$class};
306 return $list_spec{$class}->{$key};
318 SL::DB::Helper::ActsAsList - Mixin for managing ordered items by a
323 package SL::DB::SomeObject;
324 use SL::DB::Helper::ActsAsList [ PARAMS ];
326 package SL::Controller::SomeController;
328 # Assign a position automatically
329 $obj = SL::DB::SomeObject->new(description => 'bla');
332 # Move items up and down
333 $obj = SL::DB::SomeOBject->new(id => 1)->load;
334 $obj->move_position_up;
335 $obj->move_position_down;
337 # Adjust all remaining positions automatically
340 This mixin assumes that the mixing package's table contains a column
341 called C<position> or C<sortkey> (for legacy tables). This column is
342 set automatically upon saving the object if it hasn't been set
343 already. If it hasn't then it will be set to the maximum position used
344 in the table plus one.
346 When the object is deleted all positions greater than the object's old
347 position are decreased by one.
349 C<PARAMS> will be given to L<configure_acts_as_list> and can be used to
352 =head1 CLASS FUNCTIONS
356 =item C<configure_acts_as_list %params>
358 Configures the mixin's behaviour. Will get called automatically with the
359 include parameters. C<%params> can contain the following values:
365 The name of the column containing the position. If not set explicitly
366 then the mixin will use C<sortkey> if the model contains such a column
367 (only for legacy tables) and C<position> otherwise.
371 An optional column name (or array reference of column names) by which
372 to group. If a table contains items for several distinct sets and each
373 set has its own sorting then this can be used.
375 An example would be requirement spec text blocks. They have a column
376 called C<output_position> that selects where to output the text blocks
377 (either before or after the sections). Furthermore these text blocks
378 each belong to a single requirement spec document. So each combination
379 of C<requirement_spec_id> and C<output_position> should have its own
380 set of C<position> values, which can be achieved by configuring this
381 mixin with C<group_by = [qw(requirement_spec_id output_position)]>.
387 =head1 INSTANCE FUNCTIONS
391 =item C<move_position_up>
393 Swaps the object with the object one step above the current one
394 regarding their sort order by exchanging their C<position> values.
396 =item C<move_position_down>
398 Swaps the object with the object one step below the current one
399 regarding their sort order by exchanging their C<position> values.
401 =item C<add_to_list %params>
403 Adds this item to the list. The parameter C<position> is required and
404 can be one of C<first>, C<last>, C<before> and C<after>. With C<first>
405 the item is inserted as the first item in the list and all other
406 item's positions are shifted up by one. For C<position = last> the
407 item is inserted at the end of the list.
409 For C<before> and C<after> an additional parameter C<reference> is
410 required. This is either a Rose model instance or the primary key of
411 one. The current item will then be inserted either before or after the
412 referenced item by shifting all the appropriate item positions up by
415 If C<$self>'s positional column is already set when this function is
416 called then L</remove_from_list> will be called first before anything
419 After this function C<$self>'s positional column has been set and
420 saved to the database.
422 =item C<remove_from_list>
424 Sets this items positional column to C<-1>, saves it and moves all
425 following items up by 1.
427 =item C<get_previous_in_list>
429 Fetches the previous item in the list. Returns C<undef> if C<$self> is
430 already the first one.
432 =item C<get_next_in_list>
434 Fetches the next item in the list. Returns C<undef> if C<$self> is
435 already the last one.
437 =item C<get_full_list>
439 Fetches all items in the same list as C<$self> and returns them as an
442 =item C<reorder_list @ids>
444 Re-orders the objects given in C<@ids> by their position in C<@ids> by
445 updating all of their positional columns. Each element in
446 C<@positions> must be the ID of an object. The new position is the
447 ID's index inside C<@ids> plus one (meaning the first element's new
448 position will be 1 and not 0).
450 This works by executing SQL "UPDATE" statements directly.
452 Returns the result of the whole transaction (trueish in case of
455 This method can be called both as a class method or an instance
466 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>