+ # More complex handling for the 'via' case.
+ if ($params{via}) {
+ die 'batch mode is not supported with via' if $params{batch};
+
+ my @sources = ( $self );
+ my @targets = map { SL::DB::Helper::Mappings::get_table_for_package($_) } @{ ref($params{via}) ? $params{via} : [ $params{via} ] };
+ push @targets, @{ $wanted_tables } if $wanted_tables;
+
+ my %seen = map { ($_->meta->table . $_->id => 1) } @sources;
+
+ while (@targets) {
+ my @new_sources = @sources;
+ foreach my $src (@sources) {
+ my @query = ( "${myself}_table" => $src->meta->table,
+ "${myself}_id" => $src->id,
+ "${wanted}_table" => \@targets );
+ push @new_sources,
+ @{ $get_objects->([
+ grep { !$seen{$_->$sub_wanted_table . $_->$sub_wanted_id} }
+ @{ SL::DB::Manager::RecordLink->get_all(query => [ and => \@query ]) }
+ ]) };
+ }
+
+ @sources = @new_sources;
+ %seen = map { ($_->meta->table . $_->id => 1) } @sources;
+ shift @targets;
+ }
+
+ my %wanted_tables_map = map { ($_ => 1) } @{ $wanted_tables };
+ return [ grep { $wanted_tables_map{$_->meta->table} } @sources ];
+ }
+
+ # And lastly recursive mode
+ if ($params{recursive}) {
+ my ($id_token, @ids);
+ if ($params{batch}) {
+ $id_token = sprintf 'IN (%s)', join ', ', ('?') x @{ $params{batch} };
+ @ids = @{ $params{batch} };
+ } else {
+ $id_token = '= ?';
+ @ids = ($self->id);
+ }
+
+ # don't use rose retrieval here. too slow.
+ # instead use recursive sql to get all the linked record_links entries and retrieve the objects from there
+ my $query = <<"";
+ WITH RECURSIVE record_links_rec_${wanted}(id, from_table, from_id, to_table, to_id, depth, path, cycle) AS (
+ SELECT id, from_table, from_id, to_table, to_id,
+ 1, ARRAY[id], false
+ FROM record_links
+ WHERE ${myself}_id $id_token and ${myself}_table = ?
+ UNION ALL
+ SELECT rl.id, rl.from_table, rl.from_id, rl.to_table, rl.to_id,
+ rlr.depth + 1, path || rl.id, rl.id = ANY(path)
+ FROM record_links rl, record_links_rec_${wanted} rlr
+ WHERE rlr.${wanted}_id = rl.${myself}_id AND rlr.${wanted}_table = rl.${myself}_table AND NOT cycle
+ )
+ SELECT DISTINCT ON (${wanted}_table, ${wanted}_id)
+ id, from_table, from_id, to_table, to_id, path, depth FROM record_links_rec_${wanted}
+ WHERE NOT cycle
+ ORDER BY ${wanted}_table, ${wanted}_id, depth ASC;
+
+ my $links = selectall_hashref_query($::form, $::form->get_standard_dbh, $query, @ids, $self->meta->table);
+
+ if (!@$links) {
+ return $params{by_id} ? {} : [];
+ }
+
+ my $link_objs = SL::DB::Manager::RecordLink->get_all(query => [ id => [ map { $_->{id} } @$links ] ]);
+ my $objects = $get_objects->($link_objs);
+
+ my %links_by_id = map { $_->{id} => $_ } @$links;
+
+ if ($params{save_path}) {
+ for (@$objects) {
+ for my $record_link ('ARRAY' eq ref $_->{_record_link} ? @{ $_->{_record_link} } : $_->{_record_link}) {
+ my $link = $links_by_id{$record_link->id};
+ my $intermediate_links = SL::DB::Manager::RecordLink->get_all(query => [ id => $link->{path} ]);
+ $_->{_record_link_path} = $link->{path};
+ $_->{_record_link_obj_path} = $get_objects->($intermediate_links);
+ $_->{_record_link_depth} = $link->{depth};
+ }
+ }
+ }
+
+ if ($params{batch} && $params{by_id}) {
+ my %link_obj_by_id = map { $_->id => $_ } @$link_objs;
+ return +{
+ map {
+ my $id = $_;
+ $id => [
+ grep {
+ any {
+ $link_obj_by_id{
+ $links_by_id{$_->id}->{path}->[0]
+ }->$sub_myself_id == $id
+ } 'ARRAY' eq $_->{_record_link} ? @{ $_->{_record_link} } : $_->{_record_link}
+ } @$objects
+ ]
+ } @{ $params{batch} }
+ };
+ } else {
+ return $objects;
+ }
+ }
+}
+
+sub link_to_record {
+ my $self = shift;
+ my $other = shift;
+ my %params = @_;
+
+ croak "self has no id" unless $self->id;
+ croak "other has no id" unless $other->id;
+
+ my @directions = ([ 'from', 'to' ]);
+ push @directions, [ 'to', 'from' ] if $params{bidirectional};
+ my @links;
+
+ foreach my $direction (@directions) {
+ my %data = ( $direction->[0] . "_table" => SL::DB::Helper::Mappings::get_table_for_package(ref($self)),
+ $direction->[0] . "_id" => $self->id,
+ $direction->[1] . "_table" => SL::DB::Helper::Mappings::get_table_for_package(ref($other)),
+ $direction->[1] . "_id" => $other->id,
+ );
+
+ my $link = SL::DB::Manager::RecordLink->find_by(and => [ %data ]);
+ push @links, $link ? $link : SL::DB::RecordLink->new(%data)->save;
+ }
+
+ return wantarray ? @links : $links[0];
+}
+
+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 },
+ 'SL::DB::RequirementSpec' => sub { $_[0]->id },
+ 'SL::DB::Letter' => sub { $_[0]->letternumber },
+ 'SL::DB::ShopOrder' => sub { $_[0]->shop_ordernumber },
+ 'SL::DB::EmailJournal' => sub { $_[0]->id },
+ 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::RequirementSpec' => 15,
+ '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,
+ 'SL::DB::PurchaseInvoice' => 150,
+ 'SL::DB::Letter' => 200,
+ 'SL::DB::ShopOrder' => 250,
+ 'SL::DB::EmailJournal' => 300,
+ 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
+ : $_[0]->can('itime_as_date') ? $_[0]->itime->clone->truncate(to => 'day')
+ : $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) ];
+}
+
+sub filter_linked_records {
+ my ($self_or_class, $filter, @records) = @_;
+
+ if ($filter eq 'accessible') {
+ my $employee = SL::DB::Manager::Employee->current;
+ @records = grep { !$_->can('may_be_accessed') || $_->may_be_accessed($employee) } @records;
+ } else {
+ croak "Unsupported filter parameter '${filter}'";
+ }
+
+ return \@records;