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 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 reorder_list {
  39   my ($class_or_self, @ids) = @_;
  40
  41   return 1 unless @ids;
  42
  43   my $self   = ref($class_or_self) ? $class_or_self : $class_or_self->new;
  44   my $column = column_name($self);
  45   my $result = $self->db->do_transaction(sub {
  46     my $query = qq|UPDATE | . $self->meta->table . qq| SET ${column} = ? WHERE id = ?|;
  47     my $sth   = $self->db->dbh->prepare($query) || die $self->db->dbh->errstr;
  48
  49     foreach my $new_position (1 .. scalar(@ids)) {
  50       $sth->execute($new_position, $ids[$new_position - 1]) || die $sth->errstr;
  51     }
  52
  53     $sth->finish;
  54   });
  55
  56   return $result;
  57 }
  58
  59 sub configure_acts_as_list {
  60   my ($class, %params) = @_;
  61
  62   $list_spec{$class} = {
  63     group_by    => $params{group_by},
  64     column_name => $params{column_name},
  65   };
  66 }
  67
  68 #
  69 # Helper functions
  70 #
  71
  72 sub get_group_by_where {
  73   my ($self)   = @_;
  74
  75   my $group_by = get_spec(ref $self, 'group_by') || [];
  76   $group_by    = [ $group_by ] if $group_by && !ref $group_by;
  77
  78   my @where    = map { my $value = $self->$_; defined($value) ? "(${_} = " . $value . ")" : "(${_} IS NULL)" } @{ $group_by };
  79
  80   return join ' AND ', @where;
  81 }
  82
  83 sub set_position {
  84   my ($self) = @_;
  85   my $column = column_name($self);
  86
  87   return 1 if defined $self->$column;
  88
  89   my $table        = $self->meta->table;
  90   my $where        = get_group_by_where($self);
  91   $where           = " WHERE ${where}" if $where;
  92   my $sql = <<SQL;
  93     SELECT COALESCE(max(${column}), 0)
  94     FROM ${table}
  95     ${where}
  96 SQL
  97
  98   my $max_position = $self->db->dbh->selectrow_arrayref($sql)->[0];
  99   $self->$column($max_position + 1);
 100
 101   return 1;
 102 }
 103
 104 sub remove_position {
 105   my ($self) = @_;
 106   my $column = column_name($self);
 107
 108   $self->load;
 109   return 1 unless defined $self->$column;
 110
 111   my $table    = $self->meta->table;
 112   my $value    = $self->$column;
 113   my $group_by = get_group_by_where($self);
 114   $group_by    = ' AND ' . $group_by if $group_by;
 115   my $sql      = <<SQL;
 116     UPDATE ${table}
 117     SET ${column} = ${column} - 1
 118     WHERE (${column} > ${value}) ${group_by}
 119 SQL
 120
 121   $self->db->dbh->do($sql);
 122
 123   return 1;
 124 }
 125
 126 sub do_move {
 127   my ($self, $direction) = @_;
 128   my $column             = column_name($self);
 129
 130   croak "Object has not been saved yet" unless $self->id;
 131   croak "No position set yet"           unless defined $self->$column;
 132
 133   my $table                                        = $self->meta->table;
 134   my $old_position                                 = $self->$column;
 135   my ($comp_sel, $comp_upd, $min_max, $plus_minus) = $direction eq 'up' ? ('<', '>=', 'max', '+') : ('>', '<=', 'min', '-');
 136   my $group_by                                     = get_group_by_where($self);
 137   $group_by                                        = ' AND ' . $group_by if $group_by;
 138   my $sql                                          = <<SQL;
 139     SELECT ${min_max}(${column})
 140     FROM ${table}
 141     WHERE (${column} ${comp_sel} ${old_position})
 142       ${group_by}
 143 SQL
 144
 145   my $new_position = $self->db->dbh->selectrow_arrayref($sql)->[0];
 146
 147   return undef unless defined $new_position;
 148
 149   $sql = <<SQL;
 150     UPDATE ${table}
 151     SET ${column} = ${old_position}
 152     WHERE (${column} = ${new_position})
 153      ${group_by};
 154 SQL
 155
 156   $self->db->dbh->do($sql);
 157
 158   $self->update_attributes($column => $new_position);
 159 }
 160
 161 sub column_name {
 162   my ($self) = @_;
 163   my $column = get_spec(ref $self, 'column_name');
 164   return $column if $column;
 165   return $self->can('sortkey') ? 'sortkey' : 'position';
 166 }
 167
 168 sub get_spec {
 169   my ($class, $key) = @_;
 170
 171   return undef unless $list_spec{$class};
 172   return $list_spec{$class}->{$key};
 173 }
 174
 175 1;
 176 __END__
 177
 178 =pod
 179
 180 =encoding utf8
 181
 182 =head1 NAME
 183
 184 SL::DB::Helper::ActsAsList - Mixin for managing ordered items by a
 185 column
 186
 187 =head1 SYNOPSIS
 188
 189   package SL::DB::SomeObject;
 190   use SL::DB::Helper::ActsAsList;
 191
 192   package SL::Controller::SomeController;
 193   ...
 194   # Assign a position automatically
 195   $obj = SL::DB::SomeObject->new(description => 'bla');
 196   $obj->save;
 197
 198   # Move items up and down
 199   $obj = SL::DB::SomeOBject->new(id => 1)->load;
 200   $obj->move_position_up;
 201   $obj->move_position_down;
 202
 203   # Adjust all remaining positions automatically
 204   $obj->delete
 205
 206 This mixin assumes that the mixing package's table contains a column
 207 called C<position> or C<sortkey> (for legacy tables). This column is
 208 set automatically upon saving the object if it hasn't been set
 209 already. If it hasn't then it will be set to the maximum position used
 210 in the table plus one.
 211
 212 When the object is deleted all positions greater than the object's old
 213 position are decreased by one.
 214
 215 The column name to use can be configured via L<configure_acts_as_list>.
 216
 217 =head1 CLASS FUNCTIONS
 218
 219 =over 4
 220
 221 =item C<configure_acts_as_list %params>
 222
 223 Configures the mixin's behaviour. C<%params> can contain the following
 224 values:
 225
 226 =over 2
 227
 228 =item C<column_name>
 229
 230 The name of the column containing the position. If not set explicitly
 231 then the mixin will use C<sortkey> if the model contains such a column
 232 (only for legacy tables) and C<position> otherwise.
 233
 234 =item C<group_by>
 235
 236 An optional column name (or array reference of column names) by which
 237 to group. If a table contains items for several distinct sets and each
 238 set has its own sorting then this can be used.
 239
 240 An example would be requirement spec text blocks. They have a column
 241 called C<output_position> that selects where to output the text blocks
 242 (either before or after the sections). Furthermore these text blocks
 243 each belong to a single requirement spec document. So each combination
 244 of C<requirement_spec_id> and C<output_position> should have its own
 245 set of C<position> values, which can be achieved by configuring this
 246 mixin with C<group_by = [qw(requirement_spec_id output_position)]>.
 247
 248 =back
 249
 250 =back
 251
 252 =head1 INSTANCE FUNCTIONS
 253
 254 =over 4
 255
 256 =item C<move_position_up>
 257
 258 Swaps the object with the object one step above the current one
 259 regarding their sort order by exchanging their C<position> values.
 260
 261 =item C<move_position_down>
 262
 263 Swaps the object with the object one step below the current one
 264 regarding their sort order by exchanging their C<position> values.
 265
 266 =item C<reorder_list @ids>
 267
 268 Re-orders the objects given in C<@ids> by their position in C<@ids> by
 269 updating all of their positional columns. Each element in
 270 C<@positions> must be the ID of an object. The new position is the
 271 ID's index inside C<@ids> plus one (meaning the first element's new
 272 position will be 1 and not 0).
 273
 274 This works by executing SQL "UPDATE" statements directly.
 275
 276 Returns the result of the whole transaction (trueish in case of
 277 success).
 278
 279 This method can be called both as a class method or an instance
 280 method.
 281
 282 =back
 283
 284 =head1 BUGS
 285
 286 Nothing here yet.
 287
 288 =head1 AUTHOR
 289
 290 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 291
 292 =cut