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 entrys, 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                   UNKNOWN                   => '9999999999999999',
 317                 );
 318   my $number_xtor = sub {
 319     my $number = $numbers{ ref($_[0]) };
 320     $number    = $number->($_[0]) if ref($number) eq 'CODE';
 321     return $number || $numbers{UNKNOWN};
 322   };
 323   my $number_comparator = sub {
 324     my $number_a = $number_xtor->($a);
 325     my $number_b = $number_xtor->($b);
 326
 327     ncmp($number_a, $number_b) * $sort_dir;
 328   };
 329
 330   my %scores;
 331   %scores = ( 'SL::DB::SalesProcess'    =>  10,
 332               'SL::DB::RequirementSpec' =>  15,
 333               'SL::DB::Order'           =>  sub { $scores{ $_[0]->type } },
 334               sales_quotation           =>  20,
 335               sales_order               =>  30,
 336               sales_delivery_order      =>  40,
 337               'SL::DB::DeliveryOrder'   =>  sub { $scores{ $_[0]->type } },
 338               'SL::DB::Invoice'         =>  50,
 339               request_quotation         => 120,
 340               purchase_order            => 130,
 341               purchase_delivery_order   => 140,
 342               'SL::DB::PurchaseInvoice' => 150,
 343               'SL::DB::PurchaseInvoice' => 150,
 344               'SL::DB::Letter'          => 200,
 345               'SL::DB::ShopOrder'       => 250,
 346               UNKNOWN                   => 999,
 347             );
 348   my $score_xtor = sub {
 349     my $score = $scores{ ref($_[0]) };
 350     $score    = $score->($_[0]) if ref($score) eq 'CODE';
 351     return $score || $scores{UNKNOWN};
 352   };
 353   my $type_comparator = sub {
 354     my $score_a = $score_xtor->($a);
 355     my $score_b = $score_xtor->($b);
 356
 357     $score_a == $score_b ? $number_comparator->() : ($score_a <=> $score_b) * $sort_dir;
 358   };
 359
 360   my $today     = DateTime->today_local;
 361   my $date_xtor = sub {
 362       $_[0]->can('transdate_as_date') ? $_[0]->transdate
 363     : $_[0]->can('itime_as_date')     ? $_[0]->itime->clone->truncate(to => 'day')
 364     :                                   $today;
 365   };
 366   my $date_comparator = sub {
 367     my $date_a = $date_xtor->($a);
 368     my $date_b = $date_xtor->($b);
 369
 370     ($date_a <=> $date_b) * $sort_dir;
 371   };
 372
 373   my $comparator = $sort_by eq 'number' ? $number_comparator
 374                  : $sort_by eq 'date'   ? $date_comparator
 375                  :                        $type_comparator;
 376
 377   return [ sort($comparator @records) ];
 378 }
 379
 380 sub filter_linked_records {
 381   my ($self_or_class, $filter, @records) = @_;
 382
 383   if ($filter eq 'accessible') {
 384     my $employee = SL::DB::Manager::Employee->current;
 385     @records     = grep { !$_->can('may_be_accessed') || $_->may_be_accessed($employee) } @records;
 386   } else {
 387     croak "Unsupported filter parameter '${filter}'";
 388   }
 389
 390   return \@records;
 391 }
 392
 393 1;
 394
 395 __END__
 396
 397 =encoding utf8
 398
 399 =head1 NAME
 400
 401 SL::DB::Helper::LinkedRecords - Mixin for retrieving linked records via the table C<record_links>
 402
 403 SYNOPSIS
 404
 405   # In SL::DB::<Object>
 406   use SL::DB::Helper::LinkedRecords;
 407
 408   # later in consumer code
 409   # retrieve all links in both directions
 410   my @linked_objects = $order->linked_records;
 411
 412   # only links to Invoices
 413   my @linked_objects = $order->linked_records(
 414     to        => 'Invoice',
 415   );
 416
 417   # more than one target
 418   my @linked_objects = $order->linked_records(
 419     to        => [ 'Invoice', 'Order' ],
 420   );
 421
 422   # more than one direction
 423   my @linked_objects = $order->linked_records(
 424     both      => 'Invoice',
 425   );
 426
 427   # more than one direction and different targets
 428   my @linked_objects = $order->linked_records(
 429     to        => 'Invoice',
 430     from      => 'Order',
 431   );
 432
 433   # via over known classes
 434   my @linked_objects = $order->linked_records(
 435     to        => 'Invoice',
 436     via       => 'DeliveryOrder',
 437   );
 438   my @linked_objects = $order->linked_records(
 439     to        => 'Invoice',
 440     via       => [ 'Order', 'DeliveryOrder' ],
 441   );
 442
 443   # recursive
 444   my @linked_objects = $order->linked_records(
 445     recursive => 1,
 446   );
 447
 448
 449   # limit direction when further params contain additional keys
 450   my %params = (to => 'Invoice', from => 'Order');
 451   my @linked_objects = $order->linked_records(
 452     direction => 'to',
 453     %params,
 454   );
 455
 456   # add a new link
 457   $order->link_to_record($invoice);
 458   $order->link_to_record($purchase_order, bidirectional => 1);
 459
 460
 461 =head1 FUNCTIONS
 462
 463 =over 4
 464
 465 =item C<linked_records %params>
 466
 467 Retrieves records linked from or to C<$self> via the table C<record_links>.
 468
 469 The optional parameter C<direction> (either C<from>, C<to> or C<both>)
 470 determines whether the function retrieves records that link to C<$self> (for
 471 C<direction> = C<to>) or that are linked from C<$self> (for C<direction> =
 472 C<from>). For C<direction = both> all records linked from or to C<$self> are
 473 returned.
 474
 475 The optional parameter C<from> or C<to> (same as C<direction>) contains the
 476 package names of Rose models for table limitation (the prefix C<SL::DB::> is
 477 optional). It can be a single model name as a single scalar or multiple model
 478 names in an array reference in which case all links matching any of the model
 479 names will be returned.
 480
 481 If no parameter C<direction> is given, but any of C<to>, C<from> or C<both>,
 482 then C<direction> is inferred accordingly. If neither are given, C<direction> is
 483 set to C<both>.
 484
 485 The optional parameter C<via> can be used to retrieve all documents that may
 486 have intermediate documents inbetween. It is an array reference of Rose package
 487 names for the models that may be intermediate link targets. One example is
 488 retrieving all invoices for a given quotation no matter whether or not orders
 489 and delivery orders have been created. If C<via> is given then C<from> or C<to>
 490 (depending on C<direction>) must be given as well, and it must then not be an
 491 array reference.
 492
 493 Examples:
 494
 495 If you only need invoices created directly from an order C<$order> (no
 496 delivery orders in between) then the call could look like this:
 497
 498   my $invoices = $order->linked_records(
 499     direction => 'to',
 500     to        => 'Invoice',
 501   );
 502
 503 Retrieving all invoices from a quotation no matter whether or not
 504 orders or delivery orders were created:
 505
 506   my $invoices = $quotation->linked_records(
 507     direction => 'to',
 508     to        => 'Invoice',
 509     via       => [ 'Order', 'DeliveryOrder' ],
 510   );
 511
 512 The optional parameter C<query> can be used to limit the records
 513 returned. The following call limits the earlier example to invoices
 514 created today:
 515
 516   my $invoices = $order->linked_records(
 517     direction => 'to',
 518     to        => 'Invoice',
 519     query     => [ transdate => DateTime->today_local ],
 520   );
 521
 522 In case you don't know or care which or how many objects are visited the flag
 523 C<recursive> can be used. It searches all reachable objects in the given direction:
 524
 525   my $records = $order->linked_records(
 526     direction => 'to',
 527     recursive => 1,
 528   );
 529
 530 Only link chains of the same type will be considered. So even with direction
 531 both, this
 532
 533   order 1 ---> invoice <--- order 2
 534
 535 started from order 1 will only find invoice. If an object is found both in each
 536 direction, only one copy will be returned. The recursion is cycle protected,
 537 and will not recurse infinitely. Cycles are defined by the same link being
 538 visited twice, so this
 539
 540
 541   order 1 ---> order 2 <--> delivery order
 542                  |
 543                  `--------> invoice
 544
 545 will find the path o1 -> o2 -> do -> o2 -> i without considering it a cycle.
 546
 547 The optional extra flag C<save_path> will give you extra information saved in
 548 the returned objects:
 549
 550   my $records = $order->linked_records(
 551     direction => 'to',
 552     recursive => 1,
 553     save_path => 1,
 554   );
 555
 556 Every record will have two fields set:
 557
 558 =over 2
 559
 560 =item C<_record_link_path>
 561
 562 An array with the ids of the visited links. The shortest paths will be
 563 preferred, so in the previous example this would contain the ids of o1-o2 and
 564 o2-i.
 565
 566 =item C<_record_link_depth>
 567
 568 Recursion depth when this object was found. Equal to the number of ids in
 569 C<_record_link_path>
 570
 571 =back
 572
 573 Since record_links is comparatively expensive to call, you will want to cache
 574 the results for multiple objects if you know in advance you'll need them.
 575
 576 You can pass the optional argument C<batch> with an array ref of ids which will
 577 be used instead of the id of the invocant. You still need to call it as a
 578 method on a valid object, because table information is inferred from there.
 579
 580 C<batch> mode will currenty not work with C<via>.
 581
 582 The optional flag C<by_id> will return the objects sorted into a hash instead
 583 of a plain array. Calling C<<recursive => 1, batch => [1,2], by_id => 1>> on
 584  order 1:
 585
 586   order 1 --> delivery order 1 --> invoice 1
 587   order 2 --> delivery order 2 --> invoice 2
 588
 589 will give you:
 590
 591   { 1 => [ delivery order 1, invoice 1 ],
 592     2 => [ delivery order 2, invoice 1 ], }
 593
 594 you may then cache these as you see fit.
 595
 596
 597 The optional parameters C<$params{sort_by}> and C<$params{sort_dir}>
 598 can be used in order to sort the result. If C<$params{sort_by}> is
 599 trueish then the result is sorted by calling L</sort_linked_records>.
 600
 601 The optional parameter C<$params{filter}> controls whether or not the
 602 result is filtered. Supported values are:
 603
 604 =over 2
 605
 606 =item C<accessible>
 607
 608 Removes all objects for which the function C<may_be_accessed> from the
 609 mixin L<SL::DB::Helper::MayBeAccessed> exists and returns falsish for
 610 the current employee.
 611
 612 =back
 613
 614 Returns an array reference. Each element returned is a Rose::DB
 615 instance. Additionally several elements in the element returned are
 616 set to special values:
 617
 618 =over 2
 619
 620 =item C<_record_link_direction>
 621
 622 Either C<from> or C<to> indicating the direction. C<from> means that
 623 this object is the source in the link.
 624
 625 =item C<_record_link>
 626
 627 The actual database link object (an instance of L<SL::DB::RecordLink>).
 628
 629 =back
 630
 631 =item C<link_to_record $record, %params>
 632
 633 Will create an entry in the table C<record_links> with the C<from>
 634 side being C<$self> and the C<to> side being C<$record>. Will only
 635 insert a new entry if such a link does not already exist.
 636
 637 If C<$params{bidirectional}> is trueish then another link will be
 638 created with the roles of C<from> and C<to> reversed. This link will
 639 also only be created if it doesn't exist already.
 640
 641 In scalar context returns either the existing link or the newly
 642 created one as an instance of C<SL::DB::RecordLink>. In array context
 643 it returns an array of links (one entry if C<$params{bidirectional}>
 644 is falsish and two entries if it is trueish).
 645
 646 =item C<sort_linked_records $sort_by, $sort_dir, @records>
 647
 648 Sorts linked records by C<$sort_by> in the direction given by
 649 C<$sort_dir> (trueish = ascending, falsish = descending). C<@records>
 650 can be either a single array reference or or normal array.
 651
 652 C<$sort_by> can be one of the following strings:
 653
 654 =over 2
 655
 656 =item * C<type>
 657
 658 Sort by type first and by record number second. The type order
 659 reflects the order in which records are usually processed by the
 660 employees: sales processes, sales quotations, sales orders, sales
 661 delivery orders, invoices; requests for quotation, purchase orders,
 662 purchase delivery orders, purchase invoices.
 663
 664 =item * C<number>
 665
 666 Sort by the record's running number.
 667
 668 =item * C<date>
 669
 670 Sort by the transdate of the record was created or applies to.
 671
 672 Note: If the latter has a default setting it will always mask the creation time.
 673
 674 =back
 675
 676 Returns an array reference.
 677
 678 Can only be called both as a class function since it is not exported.
 679
 680 =back
 681
 682 =head1 EXPORTS
 683
 684 This mixin exports the functions L</linked_records> and
 685 L</link_to_record>.
 686
 687 =head1 BUGS
 688
 689 Nothing here yet.
 690
 691 =head1 TODO
 692
 693  * C<recursive> should take a query param depth and cut off there
 694  * C<recursive> uses partial distinct which is known to be not terribly fast on
 695    a million entry table. replace with a better statement if this ever becomes
 696    an issue.
 697
 698 =head1 AUTHOR
 699
 700 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 701 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 702
 703 =cut