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 {
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);
61 return $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker);
65 my ($self, %params) = @_;
67 croak "Invalid parameter 'position'" unless ($params{position} || '') =~ m/^ (?: before | after | first | last ) $/x;
69 my $column = column_name($self);
71 $self->remove_from_list if ($self->$column // -1) != -1;
73 if ($params{position} eq 'last') {
79 my $table = $self->meta->table;
80 my $primary_key_col = ($self->meta->primary_key)[0];
81 my ($group_by, @values) = get_group_by_where($self);
82 $group_by = " AND ${group_by}" if $group_by;
85 if ($params{position} eq 'first') {
89 # Can only be 'before' or 'after' -- 'last' has been checked above
92 my $reference = $params{reference};
93 croak "Missing parameter 'reference'" if !$reference;
97 $reference_pos = $reference->$column;
99 ($reference_pos) = $self->db->dbh->selectrow_array(qq|SELECT ${column} FROM ${table} WHERE ${primary_key_col} = ?|, undef, $reference);
102 $new_position = $params{position} eq 'before' ? $reference_pos : $reference_pos + 1;
107 SET ${column} = ${column} + 1
108 WHERE (${column} > ?)
113 $self->db->dbh->do($query, undef, $new_position - 1, @values);
114 $self->update_attributes($column => $new_position);
117 return $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker);
120 sub get_next_in_list {
122 return get_previous_or_next($self, 'next');
125 sub get_previous_in_list {
127 return get_previous_or_next($self, 'previous');
133 my $group_by = get_spec(ref $self, 'group_by') || [];
134 $group_by = [ $group_by ] if $group_by && !ref $group_by;
135 my @where = map { ($_ => $self->$_) } @{ $group_by };
137 return $self->_get_manager_class->get_all(where => \@where, sort_by => column_name($self) . ' ASC');
141 my ($class_or_self, @ids) = @_;
143 return 1 unless @ids;
145 my $self = ref($class_or_self) ? $class_or_self : $class_or_self->new;
146 my $column = column_name($self);
147 my $result = $self->db->do_transaction(sub {
148 my $query = qq|UPDATE | . $self->meta->table . qq| SET ${column} = ? WHERE id = ?|;
149 my $sth = $self->db->dbh->prepare($query) || die $self->db->dbh->errstr;
151 foreach my $new_position (1 .. scalar(@ids)) {
152 $sth->execute($new_position, $ids[$new_position - 1]) || die $sth->errstr;
161 sub configure_acts_as_list {
162 my ($class, %params) = @_;
164 $list_spec{$class} = {
165 group_by => $params{group_by},
166 column_name => $params{column_name},
174 sub get_group_by_where {
177 my $group_by = get_spec(ref $self, 'group_by') || [];
178 $group_by = [ $group_by ] if $group_by && !ref $group_by;
180 my (@where, @values);
181 foreach my $column (@{ $group_by }) {
182 my $value = $self->$column;
183 push @values, $value if defined $value;
184 push @where, defined($value) ? "(${column} = ?)" : "(${column} IS NULL)";
187 return (join(' AND ', @where), @values);
192 my $column = column_name($self);
193 my $value = $self->$column;
195 return 1 if defined($value) && ($value != -1);
197 my $table = $self->meta->table;
198 my ($group_by, @values) = get_group_by_where($self);
199 $group_by = " AND ${group_by}" if $group_by;
201 SELECT COALESCE(MAX(${column}), 0)
203 WHERE (${column} <> -1)
207 my $max_position = $self->db->dbh->selectrow_arrayref($sql, undef, @values)->[0];
208 $self->$column($max_position + 1);
213 sub remove_position {
215 my $column = column_name($self);
218 my $value = $self->$column;
219 return 1 unless defined($value) && ($value != -1);
221 my $table = $self->meta->table;
222 my ($group_by, @values) = get_group_by_where($self);
223 $group_by = ' AND ' . $group_by if $group_by;
226 SET ${column} = ${column} - 1
227 WHERE (${column} > ?)
231 $self->db->dbh->do($sql, undef, $value, @values);
237 my ($self, $direction) = @_;
239 croak "Object has not been saved yet" unless $self->id;
241 my $column = column_name($self);
242 my $old_position = $self->$column;
243 croak "No position set yet" unless defined($old_position) && ($old_position != -1);
245 my $table = $self->meta->table;
246 my ($comp_sel, $comp_upd, $min_max, $plus_minus) = $direction eq 'up' ? ('<', '>=', 'MAX', '+') : ('>', '<=', 'MIN', '-');
247 my ($group_by, @values) = get_group_by_where($self);
248 $group_by = ' AND ' . $group_by if $group_by;
250 SELECT ${min_max}(${column})
252 WHERE (${column} <> -1)
253 AND (${column} ${comp_sel} ?)
257 my $new_position = $self->db->dbh->selectrow_arrayref($sql, undef, $old_position, @values)->[0];
259 return undef unless defined $new_position;
264 WHERE (${column} = ?)
268 $self->db->dbh->do($sql, undef, $old_position, $new_position, @values);
270 $self->update_attributes($column => $new_position);
273 sub get_previous_or_next {
274 my ($self, $direction) = @_;
276 my $asc_desc = $direction eq 'next' ? 'ASC' : 'DESC';
277 my $comparator = $direction eq 'next' ? '>' : '<';
278 my $table = $self->meta->table;
279 my $column = column_name($self);
280 my $primary_key_col = ($self->meta->primary_key)[0];
281 my ($group_by, @values) = get_group_by_where($self);
282 $group_by = " AND ${group_by}" if $group_by;
284 SELECT ${primary_key_col}
286 WHERE (${column} ${comparator} ?)
288 ORDER BY ${column} ${asc_desc}
292 my $id = ($self->db->dbh->selectrow_arrayref($sql, undef, $self->$column, @values) || [])->[0];
294 return $id ? $self->_get_manager_class->find_by(id => $id) : undef;
299 my $column = get_spec(ref $self, 'column_name');
300 return $column if $column;
301 return $self->can('sortkey') ? 'sortkey' : 'position';
305 my ($class, $key) = @_;
307 return undef unless $list_spec{$class};
308 return $list_spec{$class}->{$key};
320 SL::DB::Helper::ActsAsList - Mixin for managing ordered items by a
325 package SL::DB::SomeObject;
326 use SL::DB::Helper::ActsAsList [ PARAMS ];
328 package SL::Controller::SomeController;
330 # Assign a position automatically
331 $obj = SL::DB::SomeObject->new(description => 'bla');
334 # Move items up and down
335 $obj = SL::DB::SomeOBject->new(id => 1)->load;
336 $obj->move_position_up;
337 $obj->move_position_down;
339 # Adjust all remaining positions automatically
342 This mixin assumes that the mixing package's table contains a column
343 called C<position> or C<sortkey> (for legacy tables). This column is
344 set automatically upon saving the object if it hasn't been set
345 already. If it hasn't then it will be set to the maximum position used
346 in the table plus one.
348 When the object is deleted all positions greater than the object's old
349 position are decreased by one.
351 C<PARAMS> will be given to L<configure_acts_as_list> and can be used to
354 =head1 CLASS FUNCTIONS
358 =item C<configure_acts_as_list %params>
360 Configures the mixin's behaviour. Will get called automatically with the
361 include parameters. C<%params> can contain the following values:
367 The name of the column containing the position. If not set explicitly
368 then the mixin will use C<sortkey> if the model contains such a column
369 (only for legacy tables) and C<position> otherwise.
373 An optional column name (or array reference of column names) by which
374 to group. If a table contains items for several distinct sets and each
375 set has its own sorting then this can be used.
377 An example would be requirement spec text blocks. They have a column
378 called C<output_position> that selects where to output the text blocks
379 (either before or after the sections). Furthermore these text blocks
380 each belong to a single requirement spec document. So each combination
381 of C<requirement_spec_id> and C<output_position> should have its own
382 set of C<position> values, which can be achieved by configuring this
383 mixin with C<group_by = [qw(requirement_spec_id output_position)]>.
389 =head1 INSTANCE FUNCTIONS
393 =item C<move_position_up>
395 Swaps the object with the object one step above the current one
396 regarding their sort order by exchanging their C<position> values.
398 =item C<move_position_down>
400 Swaps the object with the object one step below the current one
401 regarding their sort order by exchanging their C<position> values.
403 =item C<add_to_list %params>
405 Adds this item to the list. The parameter C<position> is required and
406 can be one of C<first>, C<last>, C<before> and C<after>. With C<first>
407 the item is inserted as the first item in the list and all other
408 item's positions are shifted up by one. For C<position = last> the
409 item is inserted at the end of the list.
411 For C<before> and C<after> an additional parameter C<reference> is
412 required. This is either a Rose model instance or the primary key of
413 one. The current item will then be inserted either before or after the
414 referenced item by shifting all the appropriate item positions up by
417 If C<$self>'s positional column is already set when this function is
418 called then L</remove_from_list> will be called first before anything
421 After this function C<$self>'s positional column has been set and
422 saved to the database.
424 =item C<remove_from_list>
426 Sets this items positional column to C<-1>, saves it and moves all
427 following items up by 1.
429 =item C<get_previous_in_list>
431 Fetches the previous item in the list. Returns C<undef> if C<$self> is
432 already the first one.
434 =item C<get_next_in_list>
436 Fetches the next item in the list. Returns C<undef> if C<$self> is
437 already the last one.
439 =item C<get_full_list>
441 Fetches all items in the same list as C<$self> and returns them as an
444 =item C<reorder_list @ids>
446 Re-orders the objects given in C<@ids> by their position in C<@ids> by
447 updating all of their positional columns. Each element in
448 C<@positions> must be the ID of an object. The new position is the
449 ID's index inside C<@ids> plus one (meaning the first element's new
450 position will be 1 and not 0).
452 This works by executing SQL "UPDATE" statements directly.
454 Returns the result of the whole transaction (trueish in case of
457 This method can be called both as a class method or an instance
468 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>