ActsAsList: add_to_list() auch aufrufen können, wenn 'position' noch gesetzt ist
[kivitendo-erp.git] / SL / DB / Helper / ActsAsList.pm
1 package SL::DB::Helper::ActsAsList;
2
3 use strict;
4
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);
8
9 use Carp;
10
11 my %list_spec;
12
13 sub import {
14   my ($class, @params)   = @_;
15   my $importing = caller();
16
17   $importing->before_save(  sub { SL::DB::Helper::ActsAsList::set_position(@_)    });
18   $importing->before_delete(sub { SL::DB::Helper::ActsAsList::remove_position(@_) });
19
20   # Use 'goto' so that Exporter knows which module to import into via
21   # 'caller()'.
22   goto &Exporter::import;
23 }
24
25 #
26 # Exported functions
27 #
28
29 sub move_position_up {
30   my ($self) = @_;
31   do_move($self, 'up');
32 }
33
34 sub move_position_down {
35   my ($self) = @_;
36   do_move($self, 'down');
37 }
38
39 sub remove_from_list {
40   my ($self) = @_;
41
42   my $worker = sub {
43     remove_position($self);
44
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];
51     my $sql             = <<SQL;
52       UPDATE ${table}
53       SET ${column} = -1
54       WHERE ${primary_key_col} = ?
55 SQL
56     $self->db->dbh->do($sql, undef, $self->$primary_key_col);
57     $self->$column(undef);
58   };
59
60   return $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker);
61 }
62
63 sub add_to_list {
64   my ($self, %params) = @_;
65
66   croak "Invalid parameter 'position'" unless ($params{position} || '') =~ m/^ (?: before | after | first | last ) $/x;
67
68   my $column = column_name($self);
69
70   $self->remove_from_list if ($self->$column // -1) != -1;
71
72   if ($params{position} eq 'last') {
73     set_position($self);
74     $self->save;
75     return;
76   }
77
78   my $table               = $self->meta->table;
79   my $primary_key_col     = ($self->meta->primary_key)[0];
80   my ($group_by, @values) = get_group_by_where($self);
81   $group_by               = " AND ${group_by}" if $group_by;
82   my $new_position;
83
84   if ($params{position} eq 'first') {
85     $new_position = 1;
86
87   } else {
88     # Can only be 'before' or 'after' -- 'last' has been checked above
89     # already.
90
91     my $reference = $params{reference};
92     croak "Missing parameter 'reference'" if !$reference;
93
94     my $reference_pos;
95     if (ref $reference) {
96       $reference_pos = $reference->$column;
97     } else {
98       ($reference_pos) = $self->db->dbh->selectrow_array(qq|SELECT ${column} FROM ${table} WHERE ${primary_key_col} = ?|, undef, $reference);
99     }
100
101     $new_position = $params{position} eq 'before' ? $reference_pos : $reference_pos + 1;
102   }
103
104   my $query = <<SQL;
105     UPDATE ${table}
106     SET ${column} = ${column} + 1
107     WHERE (${column} > ?)
108       ${group_by}
109 SQL
110
111   my $worker = sub {
112     $self->db->dbh->do($query, undef, $new_position - 1, @values);
113     $self->update_attributes($column => $new_position);
114   };
115
116   return $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker);
117 }
118
119 sub get_next_in_list {
120   my ($self) = @_;
121   return get_previous_or_next($self, 'next');
122 }
123
124 sub get_previous_in_list {
125   my ($self) = @_;
126   return get_previous_or_next($self, 'previous');
127 }
128
129 sub get_full_list {
130   my ($self) = @_;
131
132   my $group_by = get_spec(ref $self, 'group_by') || [];
133   $group_by    = [ $group_by ] if $group_by && !ref $group_by;
134   my @where    = map { ($_ => $self->$_) } @{ $group_by };
135
136   return $self->_get_manager_class->get_all(where => \@where, sort_by => column_name($self) . ' ASC');
137 }
138
139 sub reorder_list {
140   my ($class_or_self, @ids) = @_;
141
142   return 1 unless @ids;
143
144   my $self   = ref($class_or_self) ? $class_or_self : $class_or_self->new;
145   my $column = column_name($self);
146   my $result = $self->db->do_transaction(sub {
147     my $query = qq|UPDATE | . $self->meta->table . qq| SET ${column} = ? WHERE id = ?|;
148     my $sth   = $self->db->dbh->prepare($query) || die $self->db->dbh->errstr;
149
150     foreach my $new_position (1 .. scalar(@ids)) {
151       $sth->execute($new_position, $ids[$new_position - 1]) || die $sth->errstr;
152     }
153
154     $sth->finish;
155   });
156
157   return $result;
158 }
159
160 sub configure_acts_as_list {
161   my ($class, %params) = @_;
162
163   $list_spec{$class} = {
164     group_by    => $params{group_by},
165     column_name => $params{column_name},
166   };
167 }
168
169 #
170 # Helper functions
171 #
172
173 sub get_group_by_where {
174   my ($self)   = @_;
175
176   my $group_by = get_spec(ref $self, 'group_by') || [];
177   $group_by    = [ $group_by ] if $group_by && !ref $group_by;
178
179   my (@where, @values);
180   foreach my $column (@{ $group_by }) {
181     my $value = $self->$column;
182     push @values, $value if defined $value;
183     push @where,  defined($value) ? "(${column} = ?)" : "(${column} IS NULL)";
184   }
185
186   return (join(' AND ', @where), @values);
187 }
188
189 sub set_position {
190   my ($self) = @_;
191   my $column = column_name($self);
192   my $value  = $self->$column;
193
194   return 1 if defined($value) && ($value != -1);
195
196   my $table               = $self->meta->table;
197   my ($group_by, @values) = get_group_by_where($self);
198   $group_by               = " AND ${group_by}" if $group_by;
199   my $sql                 = <<SQL;
200     SELECT COALESCE(MAX(${column}), 0)
201     FROM ${table}
202     WHERE (${column} <> -1)
203       ${group_by}
204 SQL
205
206   my $max_position = $self->db->dbh->selectrow_arrayref($sql, undef, @values)->[0];
207   $self->$column($max_position + 1);
208
209   return 1;
210 }
211
212 sub remove_position {
213   my ($self) = @_;
214   my $column = column_name($self);
215
216   $self->load;
217   my $value = $self->$column;
218   return 1 unless defined($value) && ($value != -1);
219
220   my $table               = $self->meta->table;
221   my ($group_by, @values) = get_group_by_where($self);
222   $group_by               = ' AND ' . $group_by if $group_by;
223   my $sql                 = <<SQL;
224     UPDATE ${table}
225     SET ${column} = ${column} - 1
226     WHERE (${column} > ?)
227      ${group_by}
228 SQL
229
230   $self->db->dbh->do($sql, undef, $value, @values);
231
232   return 1;
233 }
234
235 sub do_move {
236   my ($self, $direction) = @_;
237
238   croak "Object has not been saved yet" unless $self->id;
239
240   my $column       = column_name($self);
241   my $old_position = $self->$column;
242   croak "No position set yet" unless defined($old_position) && ($old_position != -1);
243
244   my $table                                        = $self->meta->table;
245   my ($comp_sel, $comp_upd, $min_max, $plus_minus) = $direction eq 'up' ? ('<', '>=', 'MAX', '+') : ('>', '<=', 'MIN', '-');
246   my ($group_by, @values)                          = get_group_by_where($self);
247   $group_by                                        = ' AND ' . $group_by if $group_by;
248   my $sql                                          = <<SQL;
249     SELECT ${min_max}(${column})
250     FROM ${table}
251     WHERE (${column} <>          -1)
252       AND (${column} ${comp_sel} ?)
253       ${group_by}
254 SQL
255
256   my $new_position = $self->db->dbh->selectrow_arrayref($sql, undef, $old_position, @values)->[0];
257
258   return undef unless defined $new_position;
259
260   $sql = <<SQL;
261     UPDATE ${table}
262     SET ${column} = ?
263     WHERE (${column} = ?)
264      ${group_by};
265 SQL
266
267   $self->db->dbh->do($sql, undef, $old_position, $new_position, @values);
268
269   $self->update_attributes($column => $new_position);
270 }
271
272 sub get_previous_or_next {
273   my ($self, $direction)  = @_;
274
275   my $asc_desc            = $direction eq 'next' ? 'ASC' : 'DESC';
276   my $comparator          = $direction eq 'next' ? '>'   : '<';
277   my $table               = $self->meta->table;
278   my $column              = column_name($self);
279   my $primary_key_col     = ($self->meta->primary_key)[0];
280   my ($group_by, @values) = get_group_by_where($self);
281   $group_by               = " AND ${group_by}" if $group_by;
282   my $sql                 = <<SQL;
283     SELECT ${primary_key_col}
284     FROM ${table}
285     WHERE (${column} ${comparator} ?)
286       ${group_by}
287     ORDER BY ${column} ${asc_desc}
288     LIMIT 1
289 SQL
290
291   my $id = ($self->db->dbh->selectrow_arrayref($sql, undef, $self->$column, @values) || [])->[0];
292
293   return $id ? $self->_get_manager_class->find_by(id => $id) : undef;
294 }
295
296 sub column_name {
297   my ($self) = @_;
298   my $column = get_spec(ref $self, 'column_name');
299   return $column if $column;
300   return $self->can('sortkey') ? 'sortkey' : 'position';
301 }
302
303 sub get_spec {
304   my ($class, $key) = @_;
305
306   return undef unless $list_spec{$class};
307   return $list_spec{$class}->{$key};
308 }
309
310 1;
311 __END__
312
313 =pod
314
315 =encoding utf8
316
317 =head1 NAME
318
319 SL::DB::Helper::ActsAsList - Mixin for managing ordered items by a
320 column
321
322 =head1 SYNOPSIS
323
324   package SL::DB::SomeObject;
325   use SL::DB::Helper::ActsAsList;
326
327   package SL::Controller::SomeController;
328   ...
329   # Assign a position automatically
330   $obj = SL::DB::SomeObject->new(description => 'bla');
331   $obj->save;
332
333   # Move items up and down
334   $obj = SL::DB::SomeOBject->new(id => 1)->load;
335   $obj->move_position_up;
336   $obj->move_position_down;
337
338   # Adjust all remaining positions automatically
339   $obj->delete
340
341 This mixin assumes that the mixing package's table contains a column
342 called C<position> or C<sortkey> (for legacy tables). This column is
343 set automatically upon saving the object if it hasn't been set
344 already. If it hasn't then it will be set to the maximum position used
345 in the table plus one.
346
347 When the object is deleted all positions greater than the object's old
348 position are decreased by one.
349
350 The column name to use can be configured via L<configure_acts_as_list>.
351
352 =head1 CLASS FUNCTIONS
353
354 =over 4
355
356 =item C<configure_acts_as_list %params>
357
358 Configures the mixin's behaviour. C<%params> can contain the following
359 values:
360
361 =over 2
362
363 =item C<column_name>
364
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.
368
369 =item C<group_by>
370
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.
374
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)]>.
382
383 =back
384
385 =back
386
387 =head1 INSTANCE FUNCTIONS
388
389 =over 4
390
391 =item C<move_position_up>
392
393 Swaps the object with the object one step above the current one
394 regarding their sort order by exchanging their C<position> values.
395
396 =item C<move_position_down>
397
398 Swaps the object with the object one step below the current one
399 regarding their sort order by exchanging their C<position> values.
400
401 =item C<add_to_list %params>
402
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.
408
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
413 one.
414
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
417 else is done.
418
419 After this function C<$self>'s positional column has been set and
420 saved to the database.
421
422 =item C<remove_from_list>
423
424 Sets this items positional column to C<-1>, saves it and moves all
425 following items up by 1.
426
427 =item C<get_previous_in_list>
428
429 Fetches the previous item in the list. Returns C<undef> if C<$self> is
430 already the first one.
431
432 =item C<get_next_in_list>
433
434 Fetches the next item in the list. Returns C<undef> if C<$self> is
435 already the last one.
436
437 =item C<get_full_list>
438
439 Fetches all items in the same list as C<$self> and returns them as an
440 array reference.
441
442 =item C<reorder_list @ids>
443
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).
449
450 This works by executing SQL "UPDATE" statements directly.
451
452 Returns the result of the whole transaction (trueish in case of
453 success).
454
455 This method can be called both as a class method or an instance
456 method.
457
458 =back
459
460 =head1 BUGS
461
462 Nothing here yet.
463
464 =head1 AUTHOR
465
466 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
467
468 =cut