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