our @EXPORT = qw(linked_records link_to_record);
use Carp;
+use List::MoreUtils qw(any);
+use List::UtilsBy qw(uniq_by);
use Sort::Naturally;
+use SL::DBUtils;
use SL::DB::Helper::Mappings;
use SL::DB::RecordLink;
my $self = shift;
my %params = @_;
- my $wanted = $params{direction} || croak("Missing parameter `direction'");
+ my $wanted = $params{direction};
+
+ if (!$wanted) {
+ if ($params{to} && $params{from}) {
+ $wanted = 'both';
+ } elsif ($params{to}) {
+ $wanted = 'to';
+ } elsif ($params{from}) {
+ $wanted = 'from';
+ } else {
+ $wanted = 'both';
+ }
+ }
if ($wanted eq 'both') {
my $both = delete($params{both});
my %from_to = ( from => delete($params{from}) || $both,
to => delete($params{to}) || $both);
- 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 ];
+ 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 ];
+ }
}
if ($params{via}) {
my $sub_wanted_table = "${wanted}_table";
my $sub_wanted_id = "${wanted}_id";
+ my $sub_myself_id = "${myself}_id";
my ($wanted_classes, $wanted_tables);
if ($params{$wanted}) {
my @get_objects_query = ref($params{query}) eq 'ARRAY' ? @{ $params{query} } : ();
my $get_objects = sub {
- my ($link) = @_;
- my $manager_class = SL::DB::Helper::Mappings::get_manager_package_for_table($link->$sub_wanted_table);
- my $object_class = SL::DB::Helper::Mappings::get_package_for_table($link->$sub_wanted_table);
- eval "require " . $object_class . "; 1;";
- return map {
- $_->{_record_link_direction} = $wanted;
- $_->{_record_link} = $link;
- $_
- } @{ $manager_class->get_all(query => [ id => $link->$sub_wanted_id, @get_objects_query ]) };
+ 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 ],
+ (with_objects => $params{with_objects}) x !!$params{with_objects},
+ inject_results => 1,
+ ) };
+ }
+
+ 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;
};
# 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 );
+ "${myself}_id" => $params{batch} ? $params{batch} : $self->id );
push @query, ( "${wanted}_table" => $wanted_tables ) if $wanted_tables;
- return [ map { $get_objects->($_) } @{ SL::DB::Manager::RecordLink->get_all(query => [ and => \@query ]) } ];
+ 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;
+ }
}
# 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}) {
+ die 'batch mode is not supported with via' if $params{batch};
+
+ 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,
+ @{ $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}) {
+ 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);
+ }
+
+ # don't use rose retrieval here. too slow.
+ # instead use recursive sql to get all the linked record_links entries 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 $id_token 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, @ids, $self->meta->table);
+
+ if (!@$links) {
+ return $params{by_id} ? {} : [];
+ }
+
+ my $link_objs = SL::DB::Manager::RecordLink->get_all(query => [ id => [ map { $_->{id} } @$links ] ]);
+ my $objects = $get_objects->($link_objs);
+
+ my %links_by_id = map { $_->{id} => $_ } @$links;
+
+ if ($params{save_path}) {
+ 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;
+ }
+ }
}
sub link_to_record {
);
my $link = SL::DB::Manager::RecordLink->find_by(and => [ %data ]);
- push @links, $link ? $link : SL::DB::RecordLink->new(%data)->save unless $link;
+ push @links, $link ? $link : SL::DB::RecordLink->new(%data)->save;
}
return wantarray ? @links : $links[0];
'SL::DB::Invoice' => sub { $_[0]->invnumber },
'SL::DB::PurchaseInvoice' => sub { $_[0]->invnumber },
'SL::DB::RequirementSpec' => sub { $_[0]->id },
+ 'SL::DB::Letter' => sub { $_[0]->letternumber },
+ 'SL::DB::ShopOrder' => sub { $_[0]->shop_ordernumber },
+ 'SL::DB::EmailJournal' => sub { $_[0]->id },
+ 'SL::DB::Dunning' => sub { $_[0]->dunning_id },
+ 'SL::DB::GLTransaction' => sub { $_[0]->reference },
UNKNOWN => '9999999999999999',
);
my $number_xtor = sub {
purchase_order => 130,
purchase_delivery_order => 140,
'SL::DB::PurchaseInvoice' => 150,
+ 'SL::DB::GLTransaction' => 170,
+ 'SL::DB::Letter' => 200,
+ 'SL::DB::ShopOrder' => 250,
+ 'SL::DB::EmailJournal' => 300,
+ 'SL::DB::Dunning' => 350,
UNKNOWN => 999,
);
my $score_xtor = sub {
use SL::DB::Helper::LinkedRecords;
# later in consumer code
- # retrieve all links
- my @linked_objects = $order->linked_records(
- direction => 'both',
- );
+ # retrieve all links in both directions
+ my @linked_objects = $order->linked_records;
# only links to Invoices
my @linked_objects = $order->linked_records(
- direction => 'to',
to => 'Invoice',
);
# more than one target
my @linked_objects = $order->linked_records(
- direction => 'to',
to => [ 'Invoice', 'Order' ],
);
# more than one direction
my @linked_objects = $order->linked_records(
- direction => 'both',
both => 'Invoice',
);
# more than one direction and different targets
my @linked_objects = $order->linked_records(
- direction => 'both',
to => 'Invoice',
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');
+ my @linked_objects = $order->linked_records(
+ direction => 'to',
+ %params,
+ );
# add a new link
$order->link_to_record($invoice);
=item C<linked_records %params>
-Retrieves records linked from or to C<$self> via the table C<record_links>. The
-mandatory parameter C<direction> (either C<from>, C<to> or C<both>) determines
-whether the function retrieves records that link to C<$self> (for C<direction>
-= C<to>) or that are linked from C<$self> (for C<direction> = C<from>). For
-C<direction = both> all records linked from or to C<$self> are returned.
+Retrieves records linked from or to C<$self> via the table C<record_links>.
+
+The optional parameter C<direction> (either C<from>, C<to> or C<both>)
+determines whether the function retrieves records that link to C<$self> (for
+C<direction> = C<to>) or that are linked from C<$self> (for C<direction> =
+C<from>). For C<direction = both> all records linked from or to C<$self> are
+returned.
The optional parameter C<from> or C<to> (same as C<direction>) contains the
package names of Rose models for table limitation (the prefix C<SL::DB::> is
names in an array reference in which case all links matching any of the model
names will be returned.
+If no parameter C<direction> is given, but any of C<to>, C<from> or C<both>,
+then C<direction> is inferred accordingly. If neither are given, C<direction> is
+set to C<both>.
+
The optional parameter C<via> can be used to retrieve all documents that may
have intermediate documents inbetween. It is an array reference of Rose package
names for the models that may be intermediate link targets. One example is
Examples:
If you only need invoices created directly from an order C<$order> (no
-delivery orders inbetween) then the call could look like this:
+delivery orders in between) then the call could look like this:
my $invoices = $order->linked_records(
direction => 'to',
);
Retrieving all invoices from a quotation no matter whether or not
-orders or delivery orders where created:
+orders or delivery orders were created:
my $invoices = $quotation->linked_records(
direction => 'to',
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 information 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>
+
+An array with the ids of the visited links. The shortest paths will be
+preferred, 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
+
+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.
+
+
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>.
Returns an array reference.
-Can only be called both as a class function since it is noe exported.
+Can only be called both as a class function since it is not exported.
=back
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
projects / kivitendo-erp.git / blobdiff