SL/DB/Helper/AttrSorted.pm

   1 package SL::DB::Helper::AttrSorted;
   2
   3 use Carp;
   4 use List::Util qw(max);
   5
   6 use strict;
   7
   8 use parent qw(Exporter);
   9 our @EXPORT = qw(attr_sorted);
  10
  11 sub attr_sorted {
  12   my ($package, @attributes) = @_;
  13
  14   _make_sorted($package, $_) for @attributes;
  15 }
  16
  17 sub _make_sorted {
  18   my ($package, $attribute) = @_;
  19
  20   my %params       = ref($attribute) eq 'HASH' ? %{ $attribute } : ( unsorted => $attribute );
  21   my $unsorted_sub = $params{unsorted};
  22   my $sorted_sub   = $params{sorted}   // $params{unsorted} . '_sorted';
  23   my $position_sub = $params{position} // 'position';
  24
  25   no strict 'refs';
  26
  27   *{ $package . '::' . $sorted_sub } = sub {
  28     my ($self) = @_;
  29
  30     croak 'not an accessor' if @_ > 1;
  31
  32     my $next_position = ((max map { $_->$position_sub // 0 } @{ $self->$unsorted_sub }) // 0) + 1;
  33     return [
  34       map  { $_->[1] }
  35       sort { $a->[0] <=> $b->[0] }
  36       map  { [ $_->$position_sub // ($next_position++), $_ ] }
  37            @{ $self->$unsorted_sub }
  38     ];
  39   };
  40 }
  41
  42 1;
  43 __END__
  44
  45 =pod
  46
  47 =encoding utf8
  48
  49 =head1 NAME
  50
  51 SL::DB::Helper::AttrSorted - Attribute helper for sorting to-many
  52 relationships by a positional attribute
  53
  54 =head1 SYNOPSIS
  55
  56   # In a Rose model:
  57   use SL::DB::Helper::AttrSorted;
  58   __PACKAGE__->attr_sorted('items');
  59
  60   # Use in controller or whereever:
  61   my $items = @{ $invoice->items_sorted };
  62
  63 =head1 OVERVIEW
  64
  65 Creates a function that returns a sorted relationship. Requires that
  66 the linked objects have some kind of positional column.
  67
  68 Items for which no position has been set (e.g. because they haven't
  69 been saved yet) are sorted last but kept in the order they appear in
  70 the unsorted list.
  71
  72 =head1 FUNCTIONS
  73
  74 =over 4
  75
  76 =item C<attr_sorted @attributes>
  77
  78 Package method. Call with the names of the attributes for which the
  79 helper methods should be created. Each attribute name can be either a
  80 scalar or a hash reference if you need custom options.
  81
  82 If it's a hash reference then the following keys are supported:
  83
  84 =over 2
  85
  86 =item * C<unsorted> is the name of the relationship accessor that
  87 returns the list to be sorted. This is required, and if only a scalar
  88 is given instead of a hash reference then that scalar value is
  89 interpreted as C<unsorted>.
  90
  91 =item * C<sorted> is the name of the new function to create. It
  92 defaults to the unsorted name postfixed with C<_sorted>.
  93
  94 =item * C<position> must be a function name to be called on the
  95 objects to be sorted. It is supposed to return either C<undef> (no
  96 position has been set yet) or a numeric value. Defaults to C<position>.
  97
  98 =back
  99
 100 =back
 101
 102 =head1 BUGS
 103
 104 Nothing here yet.
 105
 106 =head1 AUTHOR
 107
 108 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 109
 110 =cut