SL/DB/Helper/LinkedRecords.pm

   1 package SL::DB::Helper::LinkedRecords;
   2
   3 use strict;
   4
   5 require Exporter;
   6 our @ISA    = qw(Exporter);
   7 our @EXPORT = qw(linked_records link_to_record);
   8
   9 use Carp;
  10 use List::MoreUtils qw(any);
  11 use List::UtilsBy qw(uniq_by);
  12 use Sort::Naturally;
  13 use SL::DBUtils;
  14
  15 use SL::DB::Helper::Mappings;
  16 use SL::DB::RecordLink;
  17
  18 sub linked_records {
  19   my ($self, %params) = @_;
  20
  21   my %sort_spec       = ( by  => delete($params{sort_by}),
  22                           dir => delete($params{sort_dir}) );
  23   my $filter          =  delete $params{filter};
  24
  25   my $records         = _linked_records_implementation($self, %params);
  26   $records            = filter_linked_records($self, $filter, @{ $records })                       if $filter;
  27   $records            = sort_linked_records($self, $sort_spec{by}, $sort_spec{dir}, @{ $records }) if $sort_spec{by};
  28
  29   return $records;
  30 }
  31
  32 sub _linked_records_implementation {
  33   my $self     = shift;
  34   my %params   = @_;
  35
  36   my $wanted   = $params{direction};
  37
  38   if (!$wanted) {
  39     if ($params{to} && $params{from}) {
  40       $wanted = 'both';
  41     } elsif ($params{to}) {
  42       $wanted = 'to';
  43     } elsif ($params{from}) {
  44       $wanted = 'from';
  45     } else {
  46       $wanted = 'both';
  47     }
  48   }
  49
  50   if ($wanted eq 'both') {
  51     my $both       = delete($params{both});
  52     my %from_to    = ( from => delete($params{from}) || $both,
  53                        to   => delete($params{to})   || $both);
  54
  55     if ($params{batch} && $params{by_id}) {
  56       my %results;
  57       my @links = (
  58         _linked_records_implementation($self, %params, direction => 'from', from => $from_to{from}),
  59         _linked_records_implementation($self, %params, direction => 'to',   to   => $from_to{to}  ),
  60       );
  61
  62       for my $by_id (@links) {
  63         for (keys %$by_id) {
  64           $results{$_} = defined $results{$_}
  65                        ? [ uniq_by { $_->id } @{ $results{$_} }, @{ $by_id->{$_} } ]
  66                        : $by_id->{$_};
  67         }
  68       }
  69
  70       return \%results;
  71     } else {
  72       my @records    = (@{ _linked_records_implementation($self, %params, direction => 'from', from => $from_to{from}) },
  73                         @{ _linked_records_implementation($self, %params, direction => 'to',   to   => $from_to{to}  ) });
  74
  75       my %record_map = map { ( ref($_) . $_->id => $_ ) } @records;
  76
  77       return [ values %record_map ];
  78     }
  79   }
  80
  81   if ($params{via}) {
  82     croak("Cannot use 'via' without '${wanted}_table'")             if !$params{$wanted};
  83     croak("Cannot use 'via' with '${wanted}_table' being an array") if ref $params{$wanted};
  84   }
  85
  86   my $myself           = $wanted eq 'from' ? 'to' : $wanted eq 'to' ? 'from' : croak("Invalid parameter `direction'");
  87   my $my_table         = SL::DB::Helper::Mappings::get_table_for_package(ref($self));
  88
  89   my $sub_wanted_table = "${wanted}_table";
  90   my $sub_wanted_id    = "${wanted}_id";
  91   my $sub_myself_id    = "${myself}_id";
  92
  93   my ($wanted_classes, $wanted_tables);
  94   if ($params{$wanted}) {
  95     $wanted_classes = ref($params{$wanted}) eq 'ARRAY' ? $params{$wanted} : [ $params{$wanted} ];
  96     $wanted_tables  = [ map { SL::DB::Helper::Mappings::get_table_for_package($_) || croak("Invalid parameter `${wanted}'") } @{ $wanted_classes } ];
  97   }
  98
  99   my @get_objects_query = ref($params{query}) eq 'ARRAY' ? @{ $params{query} } : ();
 100   my $get_objects       = sub {
 101     my ($links)        = @_;
 102     return [] unless @$links;
 103
 104     my %classes;
 105     push @{ $classes{ $_->$sub_wanted_table } //= [] }, $_->$sub_wanted_id for @$links;
 106
 107     my @objs;
 108     for (keys %classes) {
 109       my $manager_class = SL::DB::Helper::Mappings::get_manager_package_for_table($_);
 110       my $object_class  = SL::DB::Helper::Mappings::get_package_for_table($_);
 111       eval "require " . $object_class . "; 1;";
 112
 113       push @objs, @{ $manager_class->get_all(
 114         query         => [ id => $classes{$_}, @get_objects_query ],
 115         (with_objects => $params{with_objects}) x !!$params{with_objects},
 116         inject_results => 1,
 117       ) };
 118     }
 119
 120     my %objs_by_id = map { $_->id => $_ } @objs;
 121
 122     for (@$links) {
 123       if ('ARRAY' eq ref $objs_by_id{$_->$sub_wanted_id}->{_record_link}) {
 124         push @{ $objs_by_id{$_->$sub_wanted_id}->{_record_link_direction} }, $wanted;
 125         push @{ $objs_by_id{$_->$sub_wanted_id}->{_record_link          } }, $_;
 126       } elsif ($objs_by_id{$_->$sub_wanted_id}->{_record_link}) {
 127         $objs_by_id{$_->$sub_wanted_id}->{_record_link_direction} = [
 128           $objs_by_id{$_->$sub_wanted_id}->{_record_link_direction},
 129           $wanted,
 130         ];
 131         $objs_by_id{$_->$sub_wanted_id}->{_record_link}           = [
 132           $objs_by_id{$_->$sub_wanted_id}->{_record_link},
 133           $_,
 134         ];
 135       } else {
 136         $objs_by_id{$_->$sub_wanted_id}->{_record_link_direction} = $wanted;
 137         $objs_by_id{$_->$sub_wanted_id}->{_record_link}           = $_;
 138       }
 139     }
 140
 141     return \@objs;
 142   };
 143
 144   # If no 'via' is given then use a simple(r) method for querying the wanted objects.
 145   if (!$params{via} && !$params{recursive}) {
 146     my @query = ( "${myself}_table" => $my_table,
 147                   "${myself}_id"    => $params{batch} ? $params{batch} : $self->id );
 148     push @query, ( "${wanted}_table" => $wanted_tables ) if $wanted_tables;
 149
 150     my $links = SL::DB::Manager::RecordLink->get_all(query => [ and => \@query ]);
 151     my $objs  = $get_objects->($links);
 152
 153     if ($params{batch} && $params{by_id}) {
 154       return {
 155         map {
 156           my $id = $_;
 157           $_ => [
 158             grep {
 159               $_->{_record_link}->$sub_myself_id == $id
 160             } @$objs
 161           ]
 162         } @{ $params{batch} }
 163       }
 164     } else {
 165       return $objs;
 166     }
 167   }
 168
 169   # More complex handling for the 'via' case.
 170   if ($params{via}) {
 171     die 'batch mode is not supported with via' if $params{batch};
 172
 173     my @sources = ( $self );
 174     my @targets = map { SL::DB::Helper::Mappings::get_table_for_package($_) } @{ ref($params{via}) ? $params{via} : [ $params{via} ] };
 175     push @targets, @{ $wanted_tables } if $wanted_tables;
 176
 177     my %seen = map { ($_->meta->table . $_->id => 1) } @sources;
 178
 179     while (@targets) {
 180       my @new_sources = @sources;
 181       foreach my $src (@sources) {
 182         my @query = ( "${myself}_table" => $src->meta->table,
 183                       "${myself}_id"    => $src->id,
 184                       "${wanted}_table" => \@targets );
 185         push @new_sources,
 186              @{ $get_objects->([
 187                grep { !$seen{$_->$sub_wanted_table . $_->$sub_wanted_id} }
 188                @{ SL::DB::Manager::RecordLink->get_all(query => [ and => \@query ]) }
 189              ]) };
 190       }
 191
 192       @sources = @new_sources;
 193       %seen    = map { ($_->meta->table . $_->id => 1) } @sources;
 194       shift @targets;
 195     }
 196
 197     my %wanted_tables_map = map  { ($_ => 1) } @{ $wanted_tables };
 198     return [ grep { $wanted_tables_map{$_->meta->table} } @sources ];
 199   }
 200
 201   # And lastly recursive mode
 202   if ($params{recursive}) {
 203     my ($id_token, @ids);
 204     if ($params{batch}) {
 205       $id_token = sprintf 'IN (%s)', join ', ', ('?') x @{ $params{batch} };
 206       @ids      = @{ $params{batch} };
 207     } else {
 208       $id_token = '= ?';
 209       @ids      = ($self->id);
 210     }
 211
 212     # don't use rose retrieval here. too slow.
 213     # instead use recursive sql to get all the linked record_links entries and retrieve the objects from there
 214     my $query = <<"";
 215       WITH RECURSIVE record_links_rec_${wanted}(id, from_table, from_id, to_table, to_id, depth, path, cycle) AS (
 216         SELECT id, from_table, from_id, to_table, to_id,
 217           1, ARRAY[id], false
 218         FROM record_links
 219         WHERE ${myself}_id $id_token and ${myself}_table = ?
 220       UNION ALL
 221         SELECT rl.id, rl.from_table, rl.from_id, rl.to_table, rl.to_id,
 222           rlr.depth + 1, path || rl.id, rl.id = ANY(path)
 223         FROM record_links rl, record_links_rec_${wanted} rlr
 224         WHERE rlr.${wanted}_id = rl.${myself}_id AND rlr.${wanted}_table = rl.${myself}_table AND NOT cycle
 225       )
 226       SELECT DISTINCT ON (${wanted}_table, ${wanted}_id)
 227         id, from_table, from_id, to_table, to_id, path, depth FROM record_links_rec_${wanted}
 228       WHERE NOT cycle
 229       ORDER BY ${wanted}_table, ${wanted}_id, depth ASC;
 230
 231     my $links     = selectall_hashref_query($::form, $::form->get_standard_dbh, $query, @ids, $self->meta->table);
 232
 233     if (!@$links) {
 234       return $params{by_id} ? {} : [];
 235     }
 236
 237     my $link_objs = SL::DB::Manager::RecordLink->get_all(query => [ id => [ map { $_->{id} } @$links ] ]);
 238     my $objects = $get_objects->($link_objs);
 239
 240     my %links_by_id = map { $_->{id} => $_ } @$links;
 241
 242     if ($params{save_path}) {
 243        for (@$objects) {
 244          for my $record_link ('ARRAY' eq ref $_->{_record_link} ? @{ $_->{_record_link} } : $_->{_record_link}) {
 245            my $link = $links_by_id{$record_link->id};
 246            my $intermediate_links = SL::DB::Manager::RecordLink->get_all(query => [ id => $link->{path} ]);
 247            $_->{_record_link_path}     = $link->{path};
 248            $_->{_record_link_obj_path} = $get_objects->($intermediate_links);
 249            $_->{_record_link_depth}    = $link->{depth};
 250          }
 251        }
 252     }
 253
 254     if ($params{batch} && $params{by_id}) {
 255       my %link_obj_by_id = map { $_->id => $_ } @$link_objs;
 256       return +{
 257         map {
 258          my $id = $_;
 259          $id => [
 260            grep {
 261              any {
 262                $link_obj_by_id{
 263                  $links_by_id{$_->id}->{path}->[0]
 264                 }->$sub_myself_id == $id
 265              } 'ARRAY' eq $_->{_record_link} ? @{ $_->{_record_link} } : $_->{_record_link}
 266            } @$objects
 267          ]
 268         } @{ $params{batch} }
 269       };
 270     } else {
 271       return $objects;
 272     }
 273   }
 274 }
 275
 276 sub link_to_record {
 277   my $self   = shift;
 278   my $other  = shift;
 279   my %params = @_;
 280
 281   croak "self has no id"  unless $self->id;
 282   croak "other has no id" unless $other->id;
 283
 284   my @directions = ([ 'from', 'to' ]);
 285   push @directions, [ 'to', 'from' ] if $params{bidirectional};
 286   my @links;
 287
 288   foreach my $direction (@directions) {
 289     my %data = ( $direction->[0] . "_table" => SL::DB::Helper::Mappings::get_table_for_package(ref($self)),
 290                  $direction->[0] . "_id"    => $self->id,
 291                  $direction->[1] . "_table" => SL::DB::Helper::Mappings::get_table_for_package(ref($other)),
 292                  $direction->[1] . "_id"    => $other->id,
 293                );
 294
 295     my $link = SL::DB::Manager::RecordLink->find_by(and => [ %data ]);
 296     push @links, $link ? $link : SL::DB::RecordLink->new(%data)->save;
 297   }
 298
 299   return wantarray ? @links : $links[0];
 300 }
 301
 302 sub sort_linked_records {
 303   my ($self_or_class, $sort_by, $sort_dir, @records) = @_;
 304
 305   @records  = @{ $records[0] } if (1 == scalar(@records)) && (ref($records[0]) eq 'ARRAY');
 306   $sort_dir = $sort_dir * 1 ? 1 : -1;
 307
 308   my %numbers = ( 'SL::DB::SalesProcess'    => sub { $_[0]->id },
 309                   'SL::DB::Order'           => sub { $_[0]->quotation ? $_[0]->quonumber : $_[0]->ordnumber },
 310                   'SL::DB::DeliveryOrder'   => sub { $_[0]->donumber },
 311                   'SL::DB::Invoice'         => sub { $_[0]->invnumber },
 312                   'SL::DB::PurchaseInvoice' => sub { $_[0]->invnumber },
 313                   'SL::DB::RequirementSpec' => sub { $_[0]->id },
 314                   'SL::DB::Letter'          => sub { $_[0]->letternumber },
 315                   'SL::DB::ShopOrder'       => sub { $_[0]->shop_ordernumber },
 316                   'SL::DB::EmailJournal'    => sub { $_[0]->id },
 317                   UNKNOWN                   => '9999999999999999',
 318                 );
 319   my $number_xtor = sub {
 320     my $number = $numbers{ ref($_[0]) };
 321     $number    = $number->($_[0]) if ref($number) eq 'CODE';
 322     return $number || $numbers{UNKNOWN};
 323   };
 324   my $number_comparator = sub {
 325     my $number_a = $number_xtor->($a);
 326     my $number_b = $number_xtor->($b);
 327
 328     ncmp($number_a, $number_b) * $sort_dir;
 329   };
 330
 331   my %scores;
 332   %scores = ( 'SL::DB::SalesProcess'    =>  10,
 333               'SL::DB::RequirementSpec' =>  15,
 334               'SL::DB::Order'           =>  sub { $scores{ $_[0]->type } },
 335               sales_quotation           =>  20,
 336               sales_order               =>  30,
 337               sales_delivery_order      =>  40,
 338               'SL::DB::DeliveryOrder'   =>  sub { $scores{ $_[0]->type } },
 339               'SL::DB::Invoice'         =>  50,
 340               request_quotation         => 120,
 341               purchase_order            => 130,
 342               purchase_delivery_order   => 140,
 343               'SL::DB::PurchaseInvoice' => 150,
 344               'SL::DB::PurchaseInvoice' => 150,
 345               'SL::DB::Letter'          => 200,
 346               'SL::DB::ShopOrder'       => 250,
 347               'SL::DB::EmailJournal'    => 300,
 348               UNKNOWN                   => 999,
 349             );
 350   my $score_xtor = sub {
 351     my $score = $scores{ ref($_[0]) };
 352     $score    = $score->($_[0]) if ref($score) eq 'CODE';
 353     return $score || $scores{UNKNOWN};
 354   };
 355   my $type_comparator = sub {
 356     my $score_a = $score_xtor->($a);
 357     my $score_b = $score_xtor->($b);
 358
 359     $score_a == $score_b ? $number_comparator->() : ($score_a <=> $score_b) * $sort_dir;
 360   };
 361
 362   my $today     = DateTime->today_local;
 363   my $date_xtor = sub {
 364       $_[0]->can('transdate_as_date') ? $_[0]->transdate
 365     : $_[0]->can('itime_as_date')     ? $_[0]->itime->clone->truncate(to => 'day')
 366     :                                   $today;
 367   };
 368   my $date_comparator = sub {
 369     my $date_a = $date_xtor->($a);
 370     my $date_b = $date_xtor->($b);
 371
 372     ($date_a <=> $date_b) * $sort_dir;
 373   };
 374
 375   my $comparator = $sort_by eq 'number' ? $number_comparator
 376                  : $sort_by eq 'date'   ? $date_comparator
 377                  :                        $type_comparator;
 378
 379   return [ sort($comparator @records) ];
 380 }
 381
 382 sub filter_linked_records {
 383   my ($self_or_class, $filter, @records) = @_;
 384
 385   if ($filter eq 'accessible') {
 386     my $employee = SL::DB::Manager::Employee->current;
 387     @records     = grep { !$_->can('may_be_accessed') || $_->may_be_accessed($employee) } @records;
 388   } else {
 389     croak "Unsupported filter parameter '${filter}'";
 390   }
 391
 392   return \@records;
 393 }
 394
 395 1;
 396
 397 __END__
 398
 399 =encoding utf8
 400
 401 =head1 NAME
 402
 403 SL::DB::Helper::LinkedRecords - Mixin for retrieving linked records via the table C<record_links>
 404
 405 SYNOPSIS
 406
 407   # In SL::DB::<Object>
 408   use SL::DB::Helper::LinkedRecords;
 409
 410   # later in consumer code
 411   # retrieve all links in both directions
 412   my @linked_objects = $order->linked_records;
 413
 414   # only links to Invoices
 415   my @linked_objects = $order->linked_records(
 416     to        => 'Invoice',
 417   );
 418
 419   # more than one target
 420   my @linked_objects = $order->linked_records(
 421     to        => [ 'Invoice', 'Order' ],
 422   );
 423
 424   # more than one direction
 425   my @linked_objects = $order->linked_records(
 426     both      => 'Invoice',
 427   );
 428
 429   # more than one direction and different targets
 430   my @linked_objects = $order->linked_records(
 431     to        => 'Invoice',
 432     from      => 'Order',
 433   );
 434
 435   # via over known classes
 436   my @linked_objects = $order->linked_records(
 437     to        => 'Invoice',
 438     via       => 'DeliveryOrder',
 439   );
 440   my @linked_objects = $order->linked_records(
 441     to        => 'Invoice',
 442     via       => [ 'Order', 'DeliveryOrder' ],
 443   );
 444
 445   # recursive
 446   my @linked_objects = $order->linked_records(
 447     recursive => 1,
 448   );
 449
 450
 451   # limit direction when further params contain additional keys
 452   my %params = (to => 'Invoice', from => 'Order');
 453   my @linked_objects = $order->linked_records(
 454     direction => 'to',
 455     %params,
 456   );
 457
 458   # add a new link
 459   $order->link_to_record($invoice);
 460   $order->link_to_record($purchase_order, bidirectional => 1);
 461
 462
 463 =head1 FUNCTIONS
 464
 465 =over 4
 466
 467 =item C<linked_records %params>
 468
 469 Retrieves records linked from or to C<$self> via the table C<record_links>.
 470
 471 The optional parameter C<direction> (either C<from>, C<to> or C<both>)
 472 determines whether the function retrieves records that link to C<$self> (for
 473 C<direction> = C<to>) or that are linked from C<$self> (for C<direction> =
 474 C<from>). For C<direction = both> all records linked from or to C<$self> are
 475 returned.
 476
 477 The optional parameter C<from> or C<to> (same as C<direction>) contains the
 478 package names of Rose models for table limitation (the prefix C<SL::DB::> is
 479 optional). It can be a single model name as a single scalar or multiple model
 480 names in an array reference in which case all links matching any of the model
 481 names will be returned.
 482
 483 If no parameter C<direction> is given, but any of C<to>, C<from> or C<both>,
 484 then C<direction> is inferred accordingly. If neither are given, C<direction> is
 485 set to C<both>.
 486
 487 The optional parameter C<via> can be used to retrieve all documents that may
 488 have intermediate documents inbetween. It is an array reference of Rose package
 489 names for the models that may be intermediate link targets. One example is
 490 retrieving all invoices for a given quotation no matter whether or not orders
 491 and delivery orders have been created. If C<via> is given then C<from> or C<to>
 492 (depending on C<direction>) must be given as well, and it must then not be an
 493 array reference.
 494
 495 Examples:
 496
 497 If you only need invoices created directly from an order C<$order> (no
 498 delivery orders in between) then the call could look like this:
 499
 500   my $invoices = $order->linked_records(
 501     direction => 'to',
 502     to        => 'Invoice',
 503   );
 504
 505 Retrieving all invoices from a quotation no matter whether or not
 506 orders or delivery orders were created:
 507
 508   my $invoices = $quotation->linked_records(
 509     direction => 'to',
 510     to        => 'Invoice',
 511     via       => [ 'Order', 'DeliveryOrder' ],
 512   );
 513
 514 The optional parameter C<query> can be used to limit the records
 515 returned. The following call limits the earlier example to invoices
 516 created today:
 517
 518   my $invoices = $order->linked_records(
 519     direction => 'to',
 520     to        => 'Invoice',
 521     query     => [ transdate => DateTime->today_local ],
 522   );
 523
 524 In case you don't know or care which or how many objects are visited the flag
 525 C<recursive> can be used. It searches all reachable objects in the given direction:
 526
 527   my $records = $order->linked_records(
 528     direction => 'to',
 529     recursive => 1,
 530   );
 531
 532 Only link chains of the same type will be considered. So even with direction
 533 both, this
 534
 535   order 1 ---> invoice <--- order 2
 536
 537 started from order 1 will only find invoice. If an object is found both in each
 538 direction, only one copy will be returned. The recursion is cycle protected,
 539 and will not recurse infinitely. Cycles are defined by the same link being
 540 visited twice, so this
 541
 542
 543   order 1 ---> order 2 <--> delivery order
 544                  |
 545                  `--------> invoice
 546
 547 will find the path o1 -> o2 -> do -> o2 -> i without considering it a cycle.
 548
 549 The optional extra flag C<save_path> will give you extra information saved in
 550 the returned objects:
 551
 552   my $records = $order->linked_records(
 553     direction => 'to',
 554     recursive => 1,
 555     save_path => 1,
 556   );
 557
 558 Every record will have two fields set:
 559
 560 =over 2
 561
 562 =item C<_record_link_path>
 563
 564 An array with the ids of the visited links. The shortest paths will be
 565 preferred, so in the previous example this would contain the ids of o1-o2 and
 566 o2-i.
 567
 568 =item C<_record_link_depth>
 569
 570 Recursion depth when this object was found. Equal to the number of ids in
 571 C<_record_link_path>
 572
 573 =back
 574
 575 Since record_links is comparatively expensive to call, you will want to cache
 576 the results for multiple objects if you know in advance you'll need them.
 577
 578 You can pass the optional argument C<batch> with an array ref of ids which will
 579 be used instead of the id of the invocant. You still need to call it as a
 580 method on a valid object, because table information is inferred from there.
 581
 582 C<batch> mode will currenty not work with C<via>.
 583
 584 The optional flag C<by_id> will return the objects sorted into a hash instead
 585 of a plain array. Calling C<<recursive => 1, batch => [1,2], by_id => 1>> on
 586  order 1:
 587
 588   order 1 --> delivery order 1 --> invoice 1
 589   order 2 --> delivery order 2 --> invoice 2
 590
 591 will give you:
 592
 593   { 1 => [ delivery order 1, invoice 1 ],
 594     2 => [ delivery order 2, invoice 1 ], }
 595
 596 you may then cache these as you see fit.
 597
 598
 599 The optional parameters C<$params{sort_by}> and C<$params{sort_dir}>
 600 can be used in order to sort the result. If C<$params{sort_by}> is
 601 trueish then the result is sorted by calling L</sort_linked_records>.
 602
 603 The optional parameter C<$params{filter}> controls whether or not the
 604 result is filtered. Supported values are:
 605
 606 =over 2
 607
 608 =item C<accessible>
 609
 610 Removes all objects for which the function C<may_be_accessed> from the
 611 mixin L<SL::DB::Helper::MayBeAccessed> exists and returns falsish for
 612 the current employee.
 613
 614 =back
 615
 616 Returns an array reference. Each element returned is a Rose::DB
 617 instance. Additionally several elements in the element returned are
 618 set to special values:
 619
 620 =over 2
 621
 622 =item C<_record_link_direction>
 623
 624 Either C<from> or C<to> indicating the direction. C<from> means that
 625 this object is the source in the link.
 626
 627 =item C<_record_link>
 628
 629 The actual database link object (an instance of L<SL::DB::RecordLink>).
 630
 631 =back
 632
 633 =item C<link_to_record $record, %params>
 634
 635 Will create an entry in the table C<record_links> with the C<from>
 636 side being C<$self> and the C<to> side being C<$record>. Will only
 637 insert a new entry if such a link does not already exist.
 638
 639 If C<$params{bidirectional}> is trueish then another link will be
 640 created with the roles of C<from> and C<to> reversed. This link will
 641 also only be created if it doesn't exist already.
 642
 643 In scalar context returns either the existing link or the newly
 644 created one as an instance of C<SL::DB::RecordLink>. In array context
 645 it returns an array of links (one entry if C<$params{bidirectional}>
 646 is falsish and two entries if it is trueish).
 647
 648 =item C<sort_linked_records $sort_by, $sort_dir, @records>
 649
 650 Sorts linked records by C<$sort_by> in the direction given by
 651 C<$sort_dir> (trueish = ascending, falsish = descending). C<@records>
 652 can be either a single array reference or or normal array.
 653
 654 C<$sort_by> can be one of the following strings:
 655
 656 =over 2
 657
 658 =item * C<type>
 659
 660 Sort by type first and by record number second. The type order
 661 reflects the order in which records are usually processed by the
 662 employees: sales processes, sales quotations, sales orders, sales
 663 delivery orders, invoices; requests for quotation, purchase orders,
 664 purchase delivery orders, purchase invoices.
 665
 666 =item * C<number>
 667
 668 Sort by the record's running number.
 669
 670 =item * C<date>
 671
 672 Sort by the transdate of the record was created or applies to.
 673
 674 Note: If the latter has a default setting it will always mask the creation time.
 675
 676 =back
 677
 678 Returns an array reference.
 679
 680 Can only be called both as a class function since it is not exported.
 681
 682 =back
 683
 684 =head1 EXPORTS
 685
 686 This mixin exports the functions L</linked_records> and
 687 L</link_to_record>.
 688
 689 =head1 BUGS
 690
 691 Nothing here yet.
 692
 693 =head1 TODO
 694
 695  * C<recursive> should take a query param depth and cut off there
 696  * C<recursive> uses partial distinct which is known to be not terribly fast on
 697    a million entry table. replace with a better statement if this ever becomes
 698    an issue.
 699
 700 =head1 AUTHOR
 701
 702 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 703 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 704
 705 =cut