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