projekt kivitendo

use List::MoreUtils qw(any);

use List::UtilsBy qw(uniq_by);

    if ($params{batch} && $params{by_id}) {

      my %results;

      my @links = (

        _linked_records_implementation($self, %params, direction => 'from', from => $from_to{from}),

        _linked_records_implementation($self, %params, direction => 'to',   to   => $from_to{to}  ),

      );

      for my $by_id (@links) {

        for (keys %$by_id) {

          $results{$_} = defined $results{$_}

                       ? [ uniq_by { $_->id } @{ $results{$_} }, @{ $by_id->{$_} } ]

                       : $by_id->{$_};

        }

      }

      return \%results;

    } else {

      my @records    = (@{ _linked_records_implementation($self, %params, direction => 'from', from => $from_to{from}) },

                        @{ _linked_records_implementation($self, %params, direction => 'to',   to   => $from_to{to}  ) });

      my %record_map = map { ( ref($_) . $_->id => $_ ) } @records;

      return [ values %record_map ];

    }

  my $sub_myself_id    = "${myself}_id";

    my ($links)        = @_;

    return [] unless @$links;

    my %classes;

    push @{ $classes{ $_->$sub_wanted_table } //= [] }, $_->$sub_wanted_id for @$links;

    my @objs;

    for (keys %classes) {

      my $manager_class = SL::DB::Helper::Mappings::get_manager_package_for_table($_);

      my $object_class  = SL::DB::Helper::Mappings::get_package_for_table($_);

      eval "require " . $object_class . "; 1;";

      push @objs, @{ $manager_class->get_all(

        query         => [ id => $classes{$_}, @get_objects_query ],

      ) };

    }

    my %objs_by_id = map { $_->id => $_ } @objs;

    for (@$links) {

      if ('ARRAY' eq ref $objs_by_id{$_->$sub_wanted_id}->{_record_link}) {

        push @{ $objs_by_id{$_->$sub_wanted_id}->{_record_link_direction} }, $wanted;

        push @{ $objs_by_id{$_->$sub_wanted_id}->{_record_link          } }, $_;

      } elsif ($objs_by_id{$_->$sub_wanted_id}->{_record_link}) {

        $objs_by_id{$_->$sub_wanted_id}->{_record_link_direction} = [

          $objs_by_id{$_->$sub_wanted_id}->{_record_link_direction},

          $wanted,

        ];

        $objs_by_id{$_->$sub_wanted_id}->{_record_link}           = [

          $objs_by_id{$_->$sub_wanted_id}->{_record_link},

          $_,

        ];

      } else {

        $objs_by_id{$_->$sub_wanted_id}->{_record_link_direction} = $wanted;

        $objs_by_id{$_->$sub_wanted_id}->{_record_link}           = $_;

      }

    }

    return \@objs;

                  "${myself}_id"    => $params{batch} ? $params{batch} : $self->id );

    my $links = SL::DB::Manager::RecordLink->get_all(query => [ and => \@query ]);

    my $objs  = $get_objects->($links);

    if ($params{batch} && $params{by_id}) {

      return {

        map {

          my $id = $_;

          $_ => [

            grep {

              $_->{_record_link}->$sub_myself_id == $id

            } @$objs

          ]

        } @{ $params{batch} }

      }

    } else {

      return $objs;

    }

    die 'batch mode is not supported with via' if $params{batch};

             @{ $get_objects->([

               grep { !$seen{$_->$sub_wanted_table . $_->$sub_wanted_id} }

               @{ SL::DB::Manager::RecordLink->get_all(query => [ and => \@query ]) }

             ]) };

    my ($id_token, @ids);

    if ($params{batch}) {

      $id_token = sprintf 'IN (%s)', join ', ', ('?') x @{ $params{batch} };

      @ids      = @{ $params{batch} };

    } else {

      $id_token = '= ?';

      @ids      = ($self->id);

    }

        WHERE ${myself}_id $id_token and ${myself}_table = ?

    my $links     = selectall_hashref_query($::form, $::form->get_standard_dbh, $query, @ids, $self->meta->table);

    if (!@$links) {

      return $params{by_id} ? {} : [];

    }

    my $objects = $get_objects->($link_objs);

    my %links_by_id = map { $_->{id} => $_ } @$links;

       for (@$objects) {

         for my $record_link ('ARRAY' eq ref $_->{_record_link} ? @{ $_->{_record_link} } : $_->{_record_link}) {

           my $link = $links_by_id{$record_link->id};

           my $intermediate_links = SL::DB::Manager::RecordLink->get_all(query => [ id => $link->{path} ]);

           $_->{_record_link_path}     = $link->{path};

           $_->{_record_link_obj_path} = $get_objects->($intermediate_links);

           $_->{_record_link_depth}    = $link->{depth};

         }

    if ($params{batch} && $params{by_id}) {

      my %link_obj_by_id = map { $_->id => $_ } @$link_objs;

      return +{

        map {

         my $id = $_;

         $id => [

           grep {

             any {

               $link_obj_by_id{

                 $links_by_id{$_->id}->{path}->[0]

                }->$sub_myself_id == $id

             } 'ARRAY' eq $_->{_record_link} ? @{ $_->{_record_link} } : $_->{_record_link}

           } @$objects

         ]

        } @{ $params{batch} }

      };

    } else {

      return $objects;

    }

Since record_links is comparatively expensive to call, you will want to cache

the results for multiple objects if you know in advance you'll need them.

You can pass the optional argument C<batch> with an array ref of ids which will

be used instead of the id of the invocant. You still need to call it as a

method on a valid object, because table information is inferred from there.

C<batch> mode will currenty not work with C<via>.

The optional flag C<by_id> will return the objects sorted into a hash instead

of a plain array. Calling C<<recursive => 1, batch => [1,2], by_id => 1>> on

 order 1:

  order 1 --> delivery order 1 --> invoice 1

  order 2 --> delivery order 2 --> invoice 2

will give you:

  { 1 => [ delivery order 1, invoice 1 ],

    2 => [ delivery order 2, invoice 1 ], }

you may then cache these as you see fit.

use Test::More tests => 66;

use Test::Deep qw(cmp_bag);

# test batch mode

#

#

#

reset_state();

$o1 = new_order();

$o2 = new_order();

my $i1 = new_invoice();

my $i2 = new_invoice();

$o1->link_to_record($i1);

$o2->link_to_record($i2);

$links = $o1->linked_records(direction => 'to', to => 'Invoice', batch => [ $o1->id, $o2->id ]);

is_deeply [ map { $_->id } @$links ], [ $i1->id , $i2->id ], "batch works";

$links = $o1->linked_records(direction => 'to', recursive => 1, batch => [ $o1->id, $o2->id ]);

cmp_bag [ map { $_->id } @$links ], [ $i1->id , $i2->id ], "batch works recursive";

$links = $o1->linked_records(direction => 'to', to => 'Invoice', batch => [ $o1->id, $o2->id ], by_id => 1);

# $::lxdebug->dump(0,  "links", $links);

is @{ $links->{$o1->id} }, 1, "batch by_id 1";

is @{ $links->{$o2->id} }, 1, "batch by_id 2";

is keys %$links, 2, "batch by_id 3";

is $links->{$o1->id}[0]->id, $i1->id, "batch by_id 4";

is $links->{$o2->id}[0]->id, $i2->id, "batch by_id 5";

$links = $o1->linked_records(direction => 'to', recursive => 1, batch => [ $o1->id, $o2->id ], by_id => 1);

is @{ $links->{$o1->id} }, 1, "batch recursive by_id 1";

is @{ $links->{$o2->id} }, 1, "batch recursive by_id 2";

is keys %$links, 2, "batch recursive by_id 3";

is $links->{$o1->id}[0]->id, $i1->id, "batch recursive by_id 4";

is $links->{$o2->id}[0]->id, $i2->id, "batch recursive by_id 5";

$links = $o1->linked_records(direction => 'both', recursive => 1, batch => [ $o1->id, $o2->id ], by_id => 1);

is @{ $links->{$o1->id} }, 1, "batch recursive by_id direction both 1";

is @{ $links->{$o2->id} }, 1, "batch recursive by_id direction both 2";

is keys %$links, 2, "batch recursive by_id direction both 3";

is $links->{$o1->id}[0]->id, $i1->id, "batch recursive by_id direction both 4";

is $links->{$o2->id}[0]->id, $i2->id, "batch recursive by_id direction both 5";