use Carp;
use Sort::Naturally;
+use SL::DBUtils;
use SL::DB::Helper::Mappings;
use SL::DB::RecordLink;
};
# If no 'via' is given then use a simple(r) method for querying the wanted objects.
- if (!$params{via}) {
+ if (!$params{via} && !$params{recursive}) {
my @query = ( "${myself}_table" => $my_table,
"${myself}_id" => $self->id );
push @query, ( "${wanted}_table" => $wanted_tables ) if $wanted_tables;
}
# More complex handling for the 'via' case.
- my @sources = ( $self );
- my @targets = map { SL::DB::Helper::Mappings::get_table_for_package($_) } @{ ref($params{via}) ? $params{via} : [ $params{via} ] };
- push @targets, @{ $wanted_tables } if $wanted_tables;
-
- my %seen = map { ($_->meta->table . $_->id => 1) } @sources;
-
- while (@targets) {
- my @new_sources = @sources;
- foreach my $src (@sources) {
- my @query = ( "${myself}_table" => $src->meta->table,
- "${myself}_id" => $src->id,
- "${wanted}_table" => \@targets );
- push @new_sources,
- map { $get_objects->($_) }
- grep { !$seen{$_->$sub_wanted_table . $_->$sub_wanted_id} }
- @{ SL::DB::Manager::RecordLink->get_all(query => [ and => \@query ]) };
+ if ($params{via}) {
+ my @sources = ( $self );
+ my @targets = map { SL::DB::Helper::Mappings::get_table_for_package($_) } @{ ref($params{via}) ? $params{via} : [ $params{via} ] };
+ push @targets, @{ $wanted_tables } if $wanted_tables;
+
+ my %seen = map { ($_->meta->table . $_->id => 1) } @sources;
+
+ while (@targets) {
+ my @new_sources = @sources;
+ foreach my $src (@sources) {
+ my @query = ( "${myself}_table" => $src->meta->table,
+ "${myself}_id" => $src->id,
+ "${wanted}_table" => \@targets );
+ push @new_sources,
+ map { $get_objects->($_) }
+ grep { !$seen{$_->$sub_wanted_table . $_->$sub_wanted_id} }
+ @{ SL::DB::Manager::RecordLink->get_all(query => [ and => \@query ]) };
+ }
+
+ @sources = @new_sources;
+ %seen = map { ($_->meta->table . $_->id => 1) } @sources;
+ shift @targets;
}
- @sources = @new_sources;
- %seen = map { ($_->meta->table . $_->id => 1) } @sources;
- shift @targets;
+ my %wanted_tables_map = map { ($_ => 1) } @{ $wanted_tables };
+ return [ grep { $wanted_tables_map{$_->meta->table} } @sources ];
}
- my %wanted_tables_map = map { ($_ => 1) } @{ $wanted_tables };
- return [ grep { $wanted_tables_map{$_->meta->table} } @sources ];
+ # And lastly recursive mode
+ if ($params{recursive}) {
+ # don't use rose retrieval here. too slow.
+ # instead use recursive sql to get all the linked record_links entrys, and retrieve the objects from there
+ my $query = <<"";
+ WITH RECURSIVE record_links_rec_${wanted}(id, from_table, from_id, to_table, to_id, depth, path, cycle) AS (
+ SELECT id, from_table, from_id, to_table, to_id,
+ 1, ARRAY[id], false
+ FROM record_links
+ WHERE ${myself}_id = ? and ${myself}_table = ?
+ UNION ALL
+ SELECT rl.id, rl.from_table, rl.from_id, rl.to_table, rl.to_id,
+ rlr.depth + 1, path || rl.id, rl.id = ANY(path)
+ FROM record_links rl, record_links_rec_${wanted} rlr
+ WHERE rlr.${wanted}_id = rl.${myself}_id AND rlr.${wanted}_table = rl.${myself}_table AND NOT cycle
+ )
+ SELECT DISTINCT ON (${wanted}_table, ${wanted}_id)
+ id, from_table, from_id, to_table, to_id, path, depth FROM record_links_rec_${wanted}
+ WHERE NOT cycle
+ ORDER BY ${wanted}_table, ${wanted}_id, depth ASC;
+
+ my $links = selectall_hashref_query($::form, $::form->get_standard_dbh, $query, $self->id, $self->meta->table);
+ my $link_objs = SL::DB::Manager::RecordLink->get_all(query => [ id => [ map { $_->{id} } @$links ] ]);
+ my @objects = map { $get_objects->($_) } @$link_objs;
+
+ if ($params{save_path}) {
+ my %links_by_id = map { $_->{id} => $_ } @$links;
+ for (@objects) {
+ $_->{_record_link_path} = $links_by_id{$_->{_record_link}->id}->{path};
+ $_->{_record_link_depth} = $links_by_id{$_->{_record_link}->id}->{depth};
+ }
+ }
+
+ return \@objects;
+ }
}
sub link_to_record {
from => 'Order',
);
- # transitive over known classes
+ # via over known classes
my @linked_objects = $order->linked_records(
- direction => 'to',
to => 'Invoice',
via => 'DeliveryOrder',
);
+ my @linked_objects = $order->linked_records(
+ to => 'Invoice',
+ via => [ 'Order', 'DeliveryOrder' ],
+ );
+
+ # recursive
+ my @linked_objects = $order->linked_records(
+ recursive => 1,
+ );
+
# limit direction when further params contain additional keys
my %params = (to => 'Invoice', from => 'Order');
query => [ transdate => DateTime->today_local ],
);
+In case you don't know or care which or how many objects are visited the flag
+C<recursive> can be used. It searches all reachable objects in the given direction:
+
+ my $records = $order->linked_records(
+ direction => 'to',
+ recursive => 1,
+ );
+
+Only link chains of the same type will be considered. So even with direction
+both, this
+
+ order 1 ---> invoice <--- order 2
+
+started from order 1 will only find invoice. If an object is found both in each
+direction, only one copy will be returned. The recursion is cycle protected,
+and will not recurse infinitely. Cycles are defined by the same link being
+visited twice, so this
+
+
+ order 1 ---> order 2 <--> delivery order
+ |
+ `--------> invoice
+
+will find the path o1 -> o2 -> do -> o2 -> i without considering it a cycle.
+
+The optional extra flag C<save_path> will give you extra inforamtion saved in
+the returned objects:
+
+ my $records = $order->linked_records(
+ direction => 'to',
+ recursive => 1,
+ save_path => 1,
+ );
+
+Every record will have two fields set:
+
+=over 2
+
+=item C<_record_link_path>
+
+And array with the ids of the visited links. The shortest paths will be
+prefered, so in the previous example this would contain the ids of o1-o2 and
+o2-i.
+
+=item C<_record_link_depth>
+
+Recursion depth when this object was found. Equal to the number of ids in
+C<_record_link_path>
+
+=back
+
+
The optional parameters C<$params{sort_by}> and C<$params{sort_dir}>
can be used in order to sort the result. If C<$params{sort_by}> is
trueish then the result is sorted by calling L</sort_linked_records>.
Nothing here yet.
+=head1 TODO
+
+ * C<recursive> should take a query param depth and cut off there
+ * C<recursive> uses partial distinct which is known to be not terribly fast on
+ a million entry table. replace with a better statement if this ever becomes
+ an issue.
+
=head1 AUTHOR
Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
=cut
-use Test::More tests => 43;
+use Test::More tests => 49;
use strict;
use Data::Dumper;
use Support::TestSetup;
use Test::Exception;
+use List::Util qw(max);
use SL::DB::Buchungsgruppe;
use SL::DB::Currency;
$o2->link_to_record($d);
$d->link_to_record($i);
-
+# at this point the structure is:
+#
+# o1 <--> o2 ---> d ---> i
+#
$links = $d->linked_records(direction => 'both', to => 'Invoice', from => 'Order', sort_by => 'customer_id', sort_dir => 1);
is $links->[0]->id, $o2->id, 'both with different from/to 1';
is @$links, 1, 'double link is only added once 1';
$d->link_to_record($o2, bidirectional => 1);
+# at this point the structure is:
+#
+# o1 <--> o2 <--> d ---> i
+#
$links = $o2->linked_records(direction => 'to', to => 'DeliveryOrder');
is @$links, 1, 'double link is only added once 2';
is $links->[0]->{_record_link_direction}, 'from', '_record_link_direction from';
is $links->[0]->{_record_link}->to_id, $o1->id, '_record_link from';
-# check if bidi returns an array of links
+# check if bidi returns an array of links even if aready existing
my @links = $d->link_to_record($o2, bidirectional => 1);
+# at this point the structure is:
+#
+# o1 <--> o2 <--> d ---> i
+#
is @links, 2, 'bidi returns array of links in array context';
# via
# multiple links in the same direction from one object
$o1->link_to_record($d);
-$links = $o2->linked_records(direction => 'to', to => 'Invoice', via => 'DeliveryOrder');
-is $links->[0]->id, $i->id, 'simple case via links (string)';
-
# at this point the structure is:
#
-# o1 <--> o2 ---> d ---> i
+# o1 <--> o2 <--> d ---> i
# \____________,^
#
+$links = $o2->linked_records(direction => 'to', to => 'Invoice', via => 'DeliveryOrder');
+is $links->[0]->id, $i->id, 'simple case via links (string)';
+
+
# o1 must have 2 linked records now:
$links = $o1->linked_records(direction => 'to');
is @$links, 2, 'more than one link';
$sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('date', 0, @records);
is_deeply $sorted, [$d, $o1, $i, $o2], 'sorting by transdate desc';
+# now recursive stuff 2, with backlinks
+$links = $o1->linked_records(direction => 'to', recursive => 1, save_path => 1);
+is @$links, 4, 'recursive finds all 4 (backlink to self because of bidi o1<->o2)';
+
+# because of the link o1->d the longest path should be legth 2. test that
+is max(map { $_->{_record_link_depth} } @$links), 2, 'longest path is 2';
+
+$links = $o2->linked_records(direction => 'to', recursive => 1);
+is @$links, 4, 'recursive from o2 finds 4';
+
+$links = $o1->linked_records(direction => 'from', recursive => 1, save_path => 1);
+is @$links, 3, 'recursive from o1 finds 3 (not i)';
+
+$links = $i->linked_records(direction => 'from', recursive => 1, save_path => 1);
+is @$links, 3, 'recursive from i finds 3 (not i)';
+
+$links = $o1->linked_records(direction => 'both', recursive => 1, save_path => 1);
+is @$links, 4, 'recursive dir=both does not give duplicates';
1;
projects / kivitendo-erp.git / commitdiff