1 package SL::DB::Helper::ActsAsList;
5 use parent qw(Exporter);
6 our @EXPORT = qw(move_position_up move_position_down);
11 my ($class, @params) = @_;
12 my $importing = caller();
14 $importing->before_save( sub { SL::DB::Helper::ActsAsList::set_position(@_) });
15 $importing->before_delete(sub { SL::DB::Helper::ActsAsList::remove_position(@_) });
17 # Use 'goto' so that Exporter knows which module to import into via
19 goto &Exporter::import;
26 sub move_position_up {
31 sub move_position_down {
33 do_move($self, 'down');
42 my $column = column_name($self);
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);
54 my $column = column_name($self);
57 if (defined $self->$column) {
58 $self->_get_manager_class->update_all(set => { $column => \"${column} - 1" },
59 where => [ $column => { gt => $self->$column } ]);
66 my ($self, $direction) = @_;
67 my $column = column_name($self);
69 croak "Object has not been saved yet" unless $self->id;
70 croak "No position set yet" unless defined $self->$column;
72 my ($comp_sql, $comp_rdbo, $min_max, $plus_minus) = $direction eq 'up' ? ('<', 'ge', 'max', '+') : ('>', 'le', 'min', '-');
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];
76 return undef unless defined $new_position;
78 $self->_get_manager_class->update_all(set => { $column => $self->$column },
79 where => [ $column => $new_position ]);
80 $self->update_attributes($column => $new_position);
85 return $self->can('sortkey') ? 'sortkey' : 'position';
97 SL::DB::Helper::ActsAsList - Mixin for managing ordered items by a
98 column I<position> or I<sortkey>
102 package SL::DB::SomeObject;
103 use SL::DB::Helper::ActsAsList;
105 package SL::Controller::SomeController;
107 # Assign a position automatically
108 $obj = SL::DB::SomeObject->new(description => 'bla');
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;
116 # Adjust all remaining positions automatically
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.
125 When the object is deleted all positions greater than the object's old
126 position are decreased by one.
132 =item C<move_position_up>
134 Swaps the object with the object one step above the current one
135 regarding their sort order by exchanging their C<position> values.
137 =item C<move_position_down>
139 Swaps the object with the object one step below the current one
140 regarding their sort order by exchanging their C<position> values.
150 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>