projekt kivitendo

our @EXPORT = qw(linked_records link_to_record linked_records_sorted);

use Sort::Naturally;

  if ($wanted eq 'both') {

    my $both       = delete($params{both});

    my %from_to    = ( from => delete($params{from}) || $both,

                       to   => delete($params{to})   || $both);

    my @records    = (@{ $self->linked_records(%params, direction => 'from', from => $from_to{from}) },

                      @{ $self->linked_records(%params, direction => 'to',   to   => $from_to{to}  ) });

    my %record_map = map { ( ref($_) . $_->id => $_ ) } @records;

    return [ values %record_map ];

  }

    my $manager_class = SL::DB::Helpers::Mappings::get_manager_package_for_table($link->$sub_wanted_table);

    my $object_class  = SL::DB::Helpers::Mappings::get_package_for_table($link->$sub_wanted_table);

    eval "require " . $object_class . "; 1;";

    push @{ $records }, @{ $manager_class->get_all(query => [ id => $link->$sub_wanted_id, @query ]) };

sub linked_records_sorted {

  my ($self, $sort_by, $sort_dir, %params) = @_;

  return sort_linked_records($self, $sort_by, $sort_dir, $self->linked_records(%params));

}

sub sort_linked_records {

  my ($self_or_class, $sort_by, $sort_dir, @records) = @_;

  @records  = @{ $records[0] } if (1 == scalar(@records)) && (ref($records[0]) eq 'ARRAY');

  $sort_dir = $sort_dir * 1 ? 1 : -1;

  my %numbers = ( 'SL::DB::SalesProcess'    => sub { $_[0]->id },

                  'SL::DB::Order'           => sub { $_[0]->quotation ? $_[0]->quonumber : $_[0]->ordnumber },

                  'SL::DB::DeliveryOrder'   => sub { $_[0]->donumber },

                  'SL::DB::Invoice'         => sub { $_[0]->invnumber },

                  'SL::DB::PurchaseInvoice' => sub { $_[0]->invnumber },

                  UNKNOWN                   => '9999999999999999',

                );

  my $number_xtor = sub {

    my $number = $numbers{ ref($_[0]) };

    $number    = $number->($_[0]) if ref($number) eq 'CODE';

    return $number || $numbers{UNKNOWN};

  };

  my $number_comparator = sub {

    my $number_a = $number_xtor->($a);

    my $number_b = $number_xtor->($b);

    ncmp($number_a, $number_b) * $sort_dir;

  };

  my %scores;

  %scores = ( 'SL::DB::SalesProcess'    =>  10,

              'SL::DB::Order'           =>  sub { $scores{ $_[0]->type } },

              sales_quotation           =>  20,

              sales_order               =>  30,

              sales_delivery_order      =>  40,

              'SL::DB::DeliveryOrder'   =>  sub { $scores{ $_[0]->type } },

              'SL::DB::Invoice'         =>  50,

              request_quotation         => 120,

              purchase_order            => 130,

              purchase_delivery_order   => 140,

              'SL::DB::PurchaseInvoice' => 150,

              UNKNOWN                   => 999,

            );

  my $score_xtor = sub {

    my $score = $scores{ ref($_[0]) };

    $score    = $score->($_[0]) if ref($score) eq 'CODE';

    return $score || $scores{UNKNOWN};

  };

  my $type_comparator = sub {

    my $score_a = $score_xtor->($a);

    my $score_b = $score_xtor->($b);

    $score_a == $score_b ? $number_comparator->() : ($score_a <=> $score_b) * $sort_dir;

  };

  my $today     = DateTime->today_local;

  my $date_xtor = sub {

      $_[0]->can('transdate_as_date') ? $_[0]->transdate_as_date

    : $_[0]->can('itime_as_date')     ? $_[0]->itime_as_date

    :                                   $today;

  };

  my $date_comparator = sub {

    my $date_a = $date_xtor->($a);

    my $date_b = $date_xtor->($b);

    ($date_a <=> $date_b) * $sort_dir;

  };

  my $comparator = $sort_by eq 'number' ? $number_comparator

                 : $sort_by eq 'date'   ? $date_comparator

                 :                        $type_comparator;

  return [ sort($comparator @records) ];

}

C<record_links>. The mandatory parameter C<direction> (either C<from>,

C<to> or C<both>) determines whether the function retrieves records

that link to C<$self> (for C<direction> = C<to>) or that are linked

from C<$self> (for C<direction> = C<from>). For C<direction = both>

all records linked from or to C<$self> are returned.

=item C<sort_linked_records $sort_by, $sort_dir, @records>

Sorts linked records by C<$sort_by> in the direction given by

C<$sort_dir> (trueish = ascending, falsish = descending). C<@records>

can be either a single array reference or or normal array.

C<$sort_by> can be one of the following strings:

=over 2

=item * C<type>

Sort by type first and by record number second. The type order

reflects the order in which records are usually processed by the

employees: sales processes, sales quotations, sales orders, sales

delivery orders, invoices; requests for quotation, purchase orders,

purchase delivery orders, purchase invoices.

=item * C<number>

Sort by the record's running number.

=item * C<date>

Sort by the date the record was created or applies to.

Returns a hash reference.

Can be called both as a class or as an instance function.

This function is not exported.

=item C<linked_records_sorted $sort_by, $sort_dir, %params>

Returns the result of L</linked_records> sorted by

L</sort_linked_records>. C<%params> is passed to

L</linked_records>. C<$sort_by> and C<$sort_dir> are passed to

L</sort_linked_records>.

=back

=head1 EXPORTS

This mixin exports the functions L</linked_records>,

L</link_to_record> and L</linked_records_sorted>.