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