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
   8 use Carp;
   9
  10 my %list_spec;
  11
  12 sub import {
  13   my ($class, @params)   = @_;
  14   my $importing = caller();
  15
  16   $importing->before_save(  sub { SL::DB::Helper::ActsAsList::set_position(@_)    });
  17   $importing->before_delete(sub { SL::DB::Helper::ActsAsList::remove_position(@_) });
  18
  19   # Use 'goto' so that Exporter knows which module to import into via
  20   # 'caller()'.
  21   goto &Exporter::import;
  22 }
  23
  24 #
  25 # Exported functions
  26 #
  27
  28 sub move_position_up {
  29   my ($self) = @_;
  30   do_move($self, 'up');
  31 }
  32
  33 sub move_position_down {
  34   my ($self) = @_;
  35   do_move($self, 'down');
  36 }
  37
  38 sub remove_from_list {
  39   my ($self) = @_;
  40
  41   my $worker = sub {
  42     remove_position($self);
  43
  44     # Set to NULL manually because $self->update_attributes() would
  45     # trigger the before_save() hook from this very plugin assigning a
  46     # number at the end of the list again.
  47     my $table           = $self->meta->table;
  48     my $column          = column_name($self);
  49     my $primary_key_col = ($self->meta->primary_key)[0];
  50     my $sql             = <<SQL;
  51       UPDATE ${table}
  52       SET ${column} = NULL
  53       WHERE ${primary_key_col} = ?
  54 SQL
  55     $self->db->dbh->do($sql, undef, $self->$primary_key_col);
  56     $self->$column(undef);
  57   };
  58
  59   return $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker);
  60 }
  61
  62 sub add_to_list {
  63   my ($self, %params) = @_;
  64
  65   croak "Invalid parameter 'position'" unless ($params{position} || '') =~ m/^ (?: before | after | first | last ) $/x;
  66
  67   if ($params{position} eq 'last') {
  68     set_position($self);
  69     $self->save;
  70     return;
  71   }
  72
  73   my $table               = $self->meta->table;
  74   my $primary_key_col     = ($self->meta->primary_key)[0];
  75   my $column              = column_name($self);
  76   my ($group_by, @values) = get_group_by_where($self);
  77   $group_by               = " AND ${group_by}" if $group_by;
  78   my $new_position;
  79
  80   if ($params{position} eq 'first') {
  81     $new_position = 1;
  82
  83   } else {
  84     # Can only be 'before' or 'after' -- 'last' has been checked above
  85     # already.
  86
  87     my $reference = $params{reference};
  88     croak "Missing parameter 'reference'" if !$reference;
  89
  90     my $reference_pos;
  91     if (ref $reference) {
  92       $reference_pos = $reference->$column;
  93     } else {
  94       ($reference_pos) = $self->db->dbh->selectrow_array(qq|SELECT ${column} FROM ${table} WHERE ${primary_key_col} = ?|, undef, $reference);
  95     }
  96
  97     $new_position = $params{position} eq 'before' ? $reference_pos : $reference_pos + 1;
  98   }
  99
 100   my $query = <<SQL;
 101     UPDATE ${table}
 102     SET ${column} = ${column} + 1
 103     WHERE (${column} > ?)
 104       ${group_by}
 105 SQL
 106
 107   my $worker = sub {
 108     $self->db->dbh->do($query, undef, $new_position - 1, @values);
 109     $self->update_attributes($column => $new_position);
 110   };
 111
 112   return $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker);
 113 }
 114
 115 sub reorder_list {
 116   my ($class_or_self, @ids) = @_;
 117
 118   return 1 unless @ids;
 119
 120   my $self   = ref($class_or_self) ? $class_or_self : $class_or_self->new;
 121   my $column = column_name($self);
 122   my $result = $self->db->do_transaction(sub {
 123     my $query = qq|UPDATE | . $self->meta->table . qq| SET ${column} = ? WHERE id = ?|;
 124     my $sth   = $self->db->dbh->prepare($query) || die $self->db->dbh->errstr;
 125
 126     foreach my $new_position (1 .. scalar(@ids)) {
 127       $sth->execute($new_position, $ids[$new_position - 1]) || die $sth->errstr;
 128     }
 129
 130     $sth->finish;
 131   });
 132
 133   return $result;
 134 }
 135
 136 sub configure_acts_as_list {
 137   my ($class, %params) = @_;
 138
 139   $list_spec{$class} = {
 140     group_by    => $params{group_by},
 141     column_name => $params{column_name},
 142   };
 143 }
 144
 145 #
 146 # Helper functions
 147 #
 148
 149 sub get_group_by_where {
 150   my ($self)   = @_;
 151
 152   my $group_by = get_spec(ref $self, 'group_by') || [];
 153   $group_by    = [ $group_by ] if $group_by && !ref $group_by;
 154
 155   my (@where, @values);
 156   foreach my $column (@{ $group_by }) {
 157     my $value = $self->$column;
 158     push @values, $value if defined $value;
 159     push @where,  defined($value) ? "(${column} = ?)" : "(${column} IS NULL)";
 160   }
 161
 162   return (join(' AND ', @where), @values);
 163 }
 164
 165 sub set_position {
 166   my ($self) = @_;
 167   my $column = column_name($self);
 168
 169   return 1 if defined $self->$column;
 170
 171   my $table               = $self->meta->table;
 172   my ($group_by, @values) = get_group_by_where($self);
 173   my $where               = $group_by ? " WHERE ${group_by}" : '';
 174   my $sql                 = <<SQL;
 175     SELECT COALESCE(MAX(${column}), 0)
 176     FROM ${table}
 177     ${where}
 178 SQL
 179
 180   my $max_position = $self->db->dbh->selectrow_arrayref($sql, undef, @values)->[0];
 181   $self->$column($max_position + 1);
 182
 183   return 1;
 184 }
 185
 186 sub remove_position {
 187   my ($self) = @_;
 188   my $column = column_name($self);
 189
 190   $self->load;
 191   return 1 unless defined $self->$column;
 192
 193   my $table               = $self->meta->table;
 194   my $value               = $self->$column;
 195   my ($group_by, @values) = get_group_by_where($self);
 196   $group_by               = ' AND ' . $group_by if $group_by;
 197   my $sql                 = <<SQL;
 198     UPDATE ${table}
 199     SET ${column} = ${column} - 1
 200     WHERE (${column} > ?)
 201      ${group_by}
 202 SQL
 203
 204   $self->db->dbh->do($sql, undef, $value, @values);
 205
 206   return 1;
 207 }
 208
 209 sub do_move {
 210   my ($self, $direction) = @_;
 211   my $column             = column_name($self);
 212
 213   croak "Object has not been saved yet" unless $self->id;
 214   croak "No position set yet"           unless defined $self->$column;
 215
 216   my $table                                        = $self->meta->table;
 217   my $old_position                                 = $self->$column;
 218   my ($comp_sel, $comp_upd, $min_max, $plus_minus) = $direction eq 'up' ? ('<', '>=', 'MAX', '+') : ('>', '<=', 'MIN', '-');
 219   my ($group_by, @values)                          = get_group_by_where($self);
 220   $group_by                                        = ' AND ' . $group_by if $group_by;
 221   my $sql                                          = <<SQL;
 222     SELECT ${min_max}(${column})
 223     FROM ${table}
 224     WHERE (${column} ${comp_sel} ?)
 225       ${group_by}
 226 SQL
 227
 228   my $new_position = $self->db->dbh->selectrow_arrayref($sql, undef, $old_position, @values)->[0];
 229
 230   return undef unless defined $new_position;
 231
 232   $sql = <<SQL;
 233     UPDATE ${table}
 234     SET ${column} = ?
 235     WHERE (${column} = ?)
 236      ${group_by};
 237 SQL
 238
 239   $self->db->dbh->do($sql, undef, $old_position, $new_position, @values);
 240
 241   $self->update_attributes($column => $new_position);
 242 }
 243
 244 sub column_name {
 245   my ($self) = @_;
 246   my $column = get_spec(ref $self, 'column_name');
 247   return $column if $column;
 248   return $self->can('sortkey') ? 'sortkey' : 'position';
 249 }
 250
 251 sub get_spec {
 252   my ($class, $key) = @_;
 253
 254   return undef unless $list_spec{$class};
 255   return $list_spec{$class}->{$key};
 256 }
 257
 258 1;
 259 __END__
 260
 261 =pod
 262
 263 =encoding utf8
 264
 265 =head1 NAME
 266
 267 SL::DB::Helper::ActsAsList - Mixin for managing ordered items by a
 268 column
 269
 270 =head1 SYNOPSIS
 271
 272   package SL::DB::SomeObject;
 273   use SL::DB::Helper::ActsAsList;
 274
 275   package SL::Controller::SomeController;
 276   ...
 277   # Assign a position automatically
 278   $obj = SL::DB::SomeObject->new(description => 'bla');
 279   $obj->save;
 280
 281   # Move items up and down
 282   $obj = SL::DB::SomeOBject->new(id => 1)->load;
 283   $obj->move_position_up;
 284   $obj->move_position_down;
 285
 286   # Adjust all remaining positions automatically
 287   $obj->delete
 288
 289 This mixin assumes that the mixing package's table contains a column
 290 called C<position> or C<sortkey> (for legacy tables). This column is
 291 set automatically upon saving the object if it hasn't been set
 292 already. If it hasn't then it will be set to the maximum position used
 293 in the table plus one.
 294
 295 When the object is deleted all positions greater than the object's old
 296 position are decreased by one.
 297
 298 The column name to use can be configured via L<configure_acts_as_list>.
 299
 300 =head1 CLASS FUNCTIONS
 301
 302 =over 4
 303
 304 =item C<configure_acts_as_list %params>
 305
 306 Configures the mixin's behaviour. C<%params> can contain the following
 307 values:
 308
 309 =over 2
 310
 311 =item C<column_name>
 312
 313 The name of the column containing the position. If not set explicitly
 314 then the mixin will use C<sortkey> if the model contains such a column
 315 (only for legacy tables) and C<position> otherwise.
 316
 317 =item C<group_by>
 318
 319 An optional column name (or array reference of column names) by which
 320 to group. If a table contains items for several distinct sets and each
 321 set has its own sorting then this can be used.
 322
 323 An example would be requirement spec text blocks. They have a column
 324 called C<output_position> that selects where to output the text blocks
 325 (either before or after the sections). Furthermore these text blocks
 326 each belong to a single requirement spec document. So each combination
 327 of C<requirement_spec_id> and C<output_position> should have its own
 328 set of C<position> values, which can be achieved by configuring this
 329 mixin with C<group_by = [qw(requirement_spec_id output_position)]>.
 330
 331 =back
 332
 333 =back
 334
 335 =head1 INSTANCE FUNCTIONS
 336
 337 =over 4
 338
 339 =item C<move_position_up>
 340
 341 Swaps the object with the object one step above the current one
 342 regarding their sort order by exchanging their C<position> values.
 343
 344 =item C<move_position_down>
 345
 346 Swaps the object with the object one step below the current one
 347 regarding their sort order by exchanging their C<position> values.
 348
 349 =item C<add_to_list %params>
 350
 351 Adds this item to the list. The parameter C<position> is required and
 352 can be one of C<first>, C<last>, C<before> and C<after>. With C<first>
 353 the item is inserted as the first item in the list and all other
 354 item's positions are shifted up by one. For C<position = last> the
 355 item is inserted at the end of the list.
 356
 357 For C<before> and C<after> an additional parameter C<reference> is
 358 required. This is either a Rose model instance or the primary key of
 359 one. The current item will then be inserted either before or after the
 360 referenced item by shifting all the appropriate item positions up by
 361 one.
 362
 363 After this function C<$self>'s positional column has been set and
 364 saved to the database.
 365
 366 =item C<remove_from_list>
 367
 368 Sets this items positional column to C<undef>, saves it and moves all
 369 following items up by 1.
 370
 371 =item C<reorder_list @ids>
 372
 373 Re-orders the objects given in C<@ids> by their position in C<@ids> by
 374 updating all of their positional columns. Each element in
 375 C<@positions> must be the ID of an object. The new position is the
 376 ID's index inside C<@ids> plus one (meaning the first element's new
 377 position will be 1 and not 0).
 378
 379 This works by executing SQL "UPDATE" statements directly.
 380
 381 Returns the result of the whole transaction (trueish in case of
 382 success).
 383
 384 This method can be called both as a class method or an instance
 385 method.
 386
 387 =back
 388
 389 =head1 BUGS
 390
 391 Nothing here yet.
 392
 393 =head1 AUTHOR
 394
 395 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 396
 397 =cut