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);
   7
   8 use Carp;
   9
  10 sub import {
  11   my ($class, @params)   = @_;
  12   my $importing = caller();
  13
  14   $importing->before_save(  sub { SL::DB::Helper::ActsAsList::set_position(@_)    });
  15   $importing->before_delete(sub { SL::DB::Helper::ActsAsList::remove_position(@_) });
  16
  17   # Use 'goto' so that Exporter knows which module to import into via
  18   # 'caller()'.
  19   goto &Exporter::import;
  20 }
  21
  22 #
  23 # Exported functions
  24 #
  25
  26 sub move_position_up {
  27   my ($self) = @_;
  28   do_move($self, 'up');
  29 }
  30
  31 sub move_position_down {
  32   my ($self) = @_;
  33   do_move($self, 'down');
  34 }
  35
  36 sub reorder_list {
  37   my ($class_or_self, @ids) = @_;
  38
  39   return 1 unless @ids;
  40
  41   my $self   = ref($class_or_self) ? $class_or_self : $class_or_self->new;
  42   my $column = column_name($self);
  43   my $result = $self->db->do_transaction(sub {
  44     my $query = qq|UPDATE | . $self->meta->table . qq| SET ${column} = ? WHERE id = ?|;
  45     my $sth   = $self->db->dbh->prepare($query) || die $self->db->dbh->errstr;
  46
  47     foreach my $new_position (1 .. scalar(@ids)) {
  48       $sth->execute($new_position, $ids[$new_position - 1]) || die $sth->errstr;
  49     }
  50
  51     $sth->finish;
  52   });
  53
  54   return $result;
  55 }
  56
  57 #
  58 # Helper functions
  59 #
  60
  61 sub set_position {
  62   my ($self) = @_;
  63   my $column = column_name($self);
  64
  65   if (!defined $self->$column) {
  66     my $max_position = $self->db->dbh->selectrow_arrayref(qq|SELECT COALESCE(max(${column}), 0) FROM | . $self->meta->table)->[0];
  67     $self->$column($max_position + 1);
  68   }
  69
  70   return 1;
  71 }
  72
  73 sub remove_position {
  74   my ($self) = @_;
  75   my $column = column_name($self);
  76
  77   $self->load;
  78   if (defined $self->$column) {
  79     $self->_get_manager_class->update_all(set   => { $column => \"${column} - 1" },
  80                                           where => [ $column => { gt => $self->$column } ]);
  81   }
  82
  83   return 1;
  84 }
  85
  86 sub do_move {
  87   my ($self, $direction) = @_;
  88   my $column             = column_name($self);
  89
  90   croak "Object has not been saved yet" unless $self->id;
  91   croak "No position set yet"           unless defined $self->$column;
  92
  93   my ($comp_sql, $comp_rdbo, $min_max, $plus_minus) = $direction eq 'up' ? ('<', 'ge', 'max', '+') : ('>', 'le', 'min', '-');
  94
  95   my $new_position = $self->db->dbh->selectrow_arrayref(qq|SELECT ${min_max}(${column}) FROM | . $self->meta->table . qq| WHERE ${column} ${comp_sql} | . $self->$column)->[0];
  96
  97   return undef unless defined $new_position;
  98
  99   $self->_get_manager_class->update_all(set   => { $column => $self->$column },
 100                                         where => [ $column => $new_position ]);
 101   $self->update_attributes($column => $new_position);
 102 }
 103
 104 sub column_name {
 105   my ($self) = @_;
 106   return $self->can('sortkey') ? 'sortkey' : 'position';
 107 }
 108
 109 1;
 110 __END__
 111
 112 =pod
 113
 114 =encoding utf8
 115
 116 =head1 NAME
 117
 118 SL::DB::Helper::ActsAsList - Mixin for managing ordered items by a
 119 column I<position> or I<sortkey>
 120
 121 =head1 SYNOPSIS
 122
 123   package SL::DB::SomeObject;
 124   use SL::DB::Helper::ActsAsList;
 125
 126   package SL::Controller::SomeController;
 127   ...
 128   # Assign a position automatically
 129   $obj = SL::DB::SomeObject->new(description => 'bla');
 130   $obj->save;
 131
 132   # Move items up and down
 133   $obj = SL::DB::SomeOBject->new(id => 1)->load;
 134   $obj->move_position_up;
 135   $obj->move_position_down;
 136
 137   # Adjust all remaining positions automatically
 138   $obj->delete
 139
 140 This mixin assumes that the mixing package's table contains a column
 141 called C<position> or C<sortkey> (for legacy tables). This column is
 142 set automatically upon saving the object if it hasn't been set
 143 already. If it hasn't then it will be set to the maximum position used
 144 in the table plus one.
 145
 146 When the object is deleted all positions greater than the object's old
 147 position are decreased by one.
 148
 149 =head1 FUNCTIONS
 150
 151 =over 4
 152
 153 =item C<move_position_up>
 154
 155 Swaps the object with the object one step above the current one
 156 regarding their sort order by exchanging their C<position> values.
 157
 158 =item C<move_position_down>
 159
 160 Swaps the object with the object one step below the current one
 161 regarding their sort order by exchanging their C<position> values.
 162
 163 =item C<reorder_list @ids>
 164
 165 Re-orders the objects given in C<@ids> by their position in C<@ids> by
 166 updating all of their positional columns. Each element in
 167 C<@positions> must be the ID of an object. The new position is the
 168 ID's index inside C<@ids> plus one (meaning the first element's new
 169 position will be 1 and not 0).
 170
 171 This works by executing SQL "UPDATE" statements directly.
 172
 173 Returns the result of the whole transaction (trueish in case of
 174 success).
 175
 176 This method can be called both as a class method or an instance
 177 method.
 178
 179 =back
 180
 181 =head1 BUGS
 182
 183 Nothing here yet.
 184
 185 =head1 AUTHOR
 186
 187 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 188
 189 =cut