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 -1 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} = -1
  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   my $value  = $self->$column;
 169
 170   return 1 if defined($value) && ($value != -1);
 171
 172   my $table               = $self->meta->table;
 173   my ($group_by, @values) = get_group_by_where($self);
 174   $group_by               = " AND ${group_by}" if $group_by;
 175   my $sql                 = <<SQL;
 176     SELECT COALESCE(MAX(${column}), 0)
 177     FROM ${table}
 178     WHERE (${column} <> -1)
 179       ${group_by}
 180 SQL
 181
 182   my $max_position = $self->db->dbh->selectrow_arrayref($sql, undef, @values)->[0];
 183   $self->$column($max_position + 1);
 184
 185   return 1;
 186 }
 187
 188 sub remove_position {
 189   my ($self) = @_;
 190   my $column = column_name($self);
 191
 192   $self->load;
 193   my $value = $self->$column;
 194   return 1 unless 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     UPDATE ${table}
 201     SET ${column} = ${column} - 1
 202     WHERE (${column} > ?)
 203      ${group_by}
 204 SQL
 205
 206   $self->db->dbh->do($sql, undef, $value, @values);
 207
 208   return 1;
 209 }
 210
 211 sub do_move {
 212   my ($self, $direction) = @_;
 213
 214   croak "Object has not been saved yet" unless $self->id;
 215
 216   my $column       = column_name($self);
 217   my $old_position = $self->$column;
 218   croak "No position set yet" unless defined($old_position) && ($old_position != -1);
 219
 220   my $table                                        = $self->meta->table;
 221   my ($comp_sel, $comp_upd, $min_max, $plus_minus) = $direction eq 'up' ? ('<', '>=', 'MAX', '+') : ('>', '<=', 'MIN', '-');
 222   my ($group_by, @values)                          = get_group_by_where($self);
 223   $group_by                                        = ' AND ' . $group_by if $group_by;
 224   my $sql                                          = <<SQL;
 225     SELECT ${min_max}(${column})
 226     FROM ${table}
 227     WHERE (${column} <>          -1)
 228       AND (${column} ${comp_sel} ?)
 229       ${group_by}
 230 SQL
 231
 232   my $new_position = $self->db->dbh->selectrow_arrayref($sql, undef, $old_position, @values)->[0];
 233
 234   return undef unless defined $new_position;
 235
 236   $sql = <<SQL;
 237     UPDATE ${table}
 238     SET ${column} = ?
 239     WHERE (${column} = ?)
 240      ${group_by};
 241 SQL
 242
 243   $self->db->dbh->do($sql, undef, $old_position, $new_position, @values);
 244
 245   $self->update_attributes($column => $new_position);
 246 }
 247
 248 sub column_name {
 249   my ($self) = @_;
 250   my $column = get_spec(ref $self, 'column_name');
 251   return $column if $column;
 252   return $self->can('sortkey') ? 'sortkey' : 'position';
 253 }
 254
 255 sub get_spec {
 256   my ($class, $key) = @_;
 257
 258   return undef unless $list_spec{$class};
 259   return $list_spec{$class}->{$key};
 260 }
 261
 262 1;
 263 __END__
 264
 265 =pod
 266
 267 =encoding utf8
 268
 269 =head1 NAME
 270
 271 SL::DB::Helper::ActsAsList - Mixin for managing ordered items by a
 272 column
 273
 274 =head1 SYNOPSIS
 275
 276   package SL::DB::SomeObject;
 277   use SL::DB::Helper::ActsAsList;
 278
 279   package SL::Controller::SomeController;
 280   ...
 281   # Assign a position automatically
 282   $obj = SL::DB::SomeObject->new(description => 'bla');
 283   $obj->save;
 284
 285   # Move items up and down
 286   $obj = SL::DB::SomeOBject->new(id => 1)->load;
 287   $obj->move_position_up;
 288   $obj->move_position_down;
 289
 290   # Adjust all remaining positions automatically
 291   $obj->delete
 292
 293 This mixin assumes that the mixing package's table contains a column
 294 called C<position> or C<sortkey> (for legacy tables). This column is
 295 set automatically upon saving the object if it hasn't been set
 296 already. If it hasn't then it will be set to the maximum position used
 297 in the table plus one.
 298
 299 When the object is deleted all positions greater than the object's old
 300 position are decreased by one.
 301
 302 The column name to use can be configured via L<configure_acts_as_list>.
 303
 304 =head1 CLASS FUNCTIONS
 305
 306 =over 4
 307
 308 =item C<configure_acts_as_list %params>
 309
 310 Configures the mixin's behaviour. C<%params> can contain the following
 311 values:
 312
 313 =over 2
 314
 315 =item C<column_name>
 316
 317 The name of the column containing the position. If not set explicitly
 318 then the mixin will use C<sortkey> if the model contains such a column
 319 (only for legacy tables) and C<position> otherwise.
 320
 321 =item C<group_by>
 322
 323 An optional column name (or array reference of column names) by which
 324 to group. If a table contains items for several distinct sets and each
 325 set has its own sorting then this can be used.
 326
 327 An example would be requirement spec text blocks. They have a column
 328 called C<output_position> that selects where to output the text blocks
 329 (either before or after the sections). Furthermore these text blocks
 330 each belong to a single requirement spec document. So each combination
 331 of C<requirement_spec_id> and C<output_position> should have its own
 332 set of C<position> values, which can be achieved by configuring this
 333 mixin with C<group_by = [qw(requirement_spec_id output_position)]>.
 334
 335 =back
 336
 337 =back
 338
 339 =head1 INSTANCE FUNCTIONS
 340
 341 =over 4
 342
 343 =item C<move_position_up>
 344
 345 Swaps the object with the object one step above the current one
 346 regarding their sort order by exchanging their C<position> values.
 347
 348 =item C<move_position_down>
 349
 350 Swaps the object with the object one step below the current one
 351 regarding their sort order by exchanging their C<position> values.
 352
 353 =item C<add_to_list %params>
 354
 355 Adds this item to the list. The parameter C<position> is required and
 356 can be one of C<first>, C<last>, C<before> and C<after>. With C<first>
 357 the item is inserted as the first item in the list and all other
 358 item's positions are shifted up by one. For C<position = last> the
 359 item is inserted at the end of the list.
 360
 361 For C<before> and C<after> an additional parameter C<reference> is
 362 required. This is either a Rose model instance or the primary key of
 363 one. The current item will then be inserted either before or after the
 364 referenced item by shifting all the appropriate item positions up by
 365 one.
 366
 367 After this function C<$self>'s positional column has been set and
 368 saved to the database.
 369
 370 =item C<remove_from_list>
 371
 372 Sets this items positional column to C<-1>, saves it and moves all
 373 following items up by 1.
 374
 375 =item C<reorder_list @ids>
 376
 377 Re-orders the objects given in C<@ids> by their position in C<@ids> by
 378 updating all of their positional columns. Each element in
 379 C<@positions> must be the ID of an object. The new position is the
 380 ID's index inside C<@ids> plus one (meaning the first element's new
 381 position will be 1 and not 0).
 382
 383 This works by executing SQL "UPDATE" statements directly.
 384
 385 Returns the result of the whole transaction (trueish in case of
 386 success).
 387
 388 This method can be called both as a class method or an instance
 389 method.
 390
 391 =back
 392
 393 =head1 BUGS
 394
 395 Nothing here yet.
 396
 397 =head1 AUTHOR
 398
 399 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 400
 401 =cut