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);
   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 #
  37 # Helper functions
  38 #
  39
  40 sub set_position {
  41   my ($self) = @_;
  42   my $column = column_name($self);
  43
  44   if (!defined $self->$column) {
  45     my $max_position = $self->db->dbh->selectrow_arrayref(qq|SELECT COALESCE(max(${column}), 0) FROM | . $self->meta->table)->[0];
  46     $self->$column($max_position + 1);
  47   }
  48
  49   return 1;
  50 }
  51
  52 sub remove_position {
  53   my ($self) = @_;
  54   my $column = column_name($self);
  55
  56   $self->load;
  57   if (defined $self->$column) {
  58     $self->_get_manager_class->update_all(set   => { $column => \"${column} - 1" },
  59                                           where => [ $column => { gt => $self->$column } ]);
  60   }
  61
  62   return 1;
  63 }
  64
  65 sub do_move {
  66   my ($self, $direction) = @_;
  67   my $column             = column_name($self);
  68
  69   croak "Object has not been saved yet" unless $self->id;
  70   croak "No position set yet"           unless defined $self->$column;
  71
  72   my ($comp_sql, $comp_rdbo, $min_max, $plus_minus) = $direction eq 'up' ? ('<', 'ge', 'max', '+') : ('>', 'le', 'min', '-');
  73
  74   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];
  75
  76   return undef unless defined $new_position;
  77
  78   $self->_get_manager_class->update_all(set   => { $column => $self->$column },
  79                                         where => [ $column => $new_position ]);
  80   $self->update_attributes($column => $new_position);
  81 }
  82
  83 sub column_name {
  84   my ($self) = @_;
  85   return $self->can('sortkey') ? 'sortkey' : 'position';
  86 }
  87
  88 1;
  89 __END__
  90
  91 =pod
  92
  93 =encoding utf8
  94
  95 =head1 NAME
  96
  97 SL::DB::Helper::ActsAsList - Mixin for managing ordered items by a
  98 column I<position> or I<sortkey>
  99
 100 =head1 SYNOPSIS
 101
 102   package SL::DB::SomeObject;
 103   use SL::DB::Helper::ActsAsList;
 104
 105   package SL::Controller::SomeController;
 106   ...
 107   # Assign a position automatically
 108   $obj = SL::DB::SomeObject->new(description => 'bla');
 109   $obj->save;
 110
 111   # Move items up and down
 112   $obj = SL::DB::SomeOBject->new(id => 1)->load;
 113   $obj->move_position_up;
 114   $obj->move_position_down;
 115
 116   # Adjust all remaining positions automatically
 117   $obj->delete
 118
 119 This mixin assumes that the mixing package's table contains a column
 120 called C<position> or C<sortkey> (for legacy tables). This column is
 121 set automatically upon saving the object if it hasn't been set
 122 already. If it hasn't then it will be set to the maximum position used
 123 in the table plus one.
 124
 125 When the object is deleted all positions greater than the object's old
 126 position are decreased by one.
 127
 128 =head1 FUNCTIONS
 129
 130 =over 4
 131
 132 =item C<move_position_up>
 133
 134 Swaps the object with the object one step above the current one
 135 regarding their sort order by exchanging their C<position> values.
 136
 137 =item C<move_position_down>
 138
 139 Swaps the object with the object one step below the current one
 140 regarding their sort order by exchanging their C<position> values.
 141
 142 =back
 143
 144 =head1 BUGS
 145
 146 Nothing here yet.
 147
 148 =head1 AUTHOR
 149
 150 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 151
 152 =cut