1 package SL::DB::Helper::LinkedRecords;
6 our @ISA = qw(Exporter);
7 our @EXPORT = qw(linked_records link_to_record);
12 use SL::DB::Helper::Mappings;
13 use SL::DB::RecordLink;
16 my ($self, %params) = @_;
18 my %sort_spec = ( by => delete($params{sort_by}),
19 dir => delete($params{sort_dir}) );
20 my $filter = delete $params{filter};
22 my $records = _linked_records_implementation($self, %params);
23 $records = filter_linked_records($self, $filter, @{ $records }) if $filter;
24 $records = sort_linked_records($self, $sort_spec{by}, $sort_spec{dir}, @{ $records }) if $sort_spec{by};
29 sub _linked_records_implementation {
33 my $wanted = $params{direction};
36 if ($params{to} && $params{from}) {
38 } elsif ($params{to}) {
40 } elsif ($params{from}) {
47 if ($wanted eq 'both') {
48 my $both = delete($params{both});
49 my %from_to = ( from => delete($params{from}) || $both,
50 to => delete($params{to}) || $both);
52 my @records = (@{ _linked_records_implementation($self, %params, direction => 'from', from => $from_to{from}) },
53 @{ _linked_records_implementation($self, %params, direction => 'to', to => $from_to{to} ) });
55 my %record_map = map { ( ref($_) . $_->id => $_ ) } @records;
57 return [ values %record_map ];
61 croak("Cannot use 'via' without '${wanted}_table'") if !$params{$wanted};
62 croak("Cannot use 'via' with '${wanted}_table' being an array") if ref $params{$wanted};
65 my $myself = $wanted eq 'from' ? 'to' : $wanted eq 'to' ? 'from' : croak("Invalid parameter `direction'");
66 my $my_table = SL::DB::Helper::Mappings::get_table_for_package(ref($self));
68 my $sub_wanted_table = "${wanted}_table";
69 my $sub_wanted_id = "${wanted}_id";
71 my ($wanted_classes, $wanted_tables);
72 if ($params{$wanted}) {
73 $wanted_classes = ref($params{$wanted}) eq 'ARRAY' ? $params{$wanted} : [ $params{$wanted} ];
74 $wanted_tables = [ map { SL::DB::Helper::Mappings::get_table_for_package($_) || croak("Invalid parameter `${wanted}'") } @{ $wanted_classes } ];
77 my @get_objects_query = ref($params{query}) eq 'ARRAY' ? @{ $params{query} } : ();
78 my $get_objects = sub {
80 my $manager_class = SL::DB::Helper::Mappings::get_manager_package_for_table($link->$sub_wanted_table);
81 my $object_class = SL::DB::Helper::Mappings::get_package_for_table($link->$sub_wanted_table);
82 eval "require " . $object_class . "; 1;";
84 $_->{_record_link_direction} = $wanted;
85 $_->{_record_link} = $link;
87 } @{ $manager_class->get_all(query => [ id => $link->$sub_wanted_id, @get_objects_query ]) };
90 # If no 'via' is given then use a simple(r) method for querying the wanted objects.
92 my @query = ( "${myself}_table" => $my_table,
93 "${myself}_id" => $self->id );
94 push @query, ( "${wanted}_table" => $wanted_tables ) if $wanted_tables;
96 return [ map { $get_objects->($_) } @{ SL::DB::Manager::RecordLink->get_all(query => [ and => \@query ]) } ];
99 # More complex handling for the 'via' case.
100 my @sources = ( $self );
101 my @targets = map { SL::DB::Helper::Mappings::get_table_for_package($_) } @{ ref($params{via}) ? $params{via} : [ $params{via} ] };
102 push @targets, @{ $wanted_tables } if $wanted_tables;
104 my %seen = map { ($_->meta->table . $_->id => 1) } @sources;
107 my @new_sources = @sources;
108 foreach my $src (@sources) {
109 my @query = ( "${myself}_table" => $src->meta->table,
110 "${myself}_id" => $src->id,
111 "${wanted}_table" => \@targets );
113 map { $get_objects->($_) }
114 grep { !$seen{$_->$sub_wanted_table . $_->$sub_wanted_id} }
115 @{ SL::DB::Manager::RecordLink->get_all(query => [ and => \@query ]) };
118 @sources = @new_sources;
119 %seen = map { ($_->meta->table . $_->id => 1) } @sources;
123 my %wanted_tables_map = map { ($_ => 1) } @{ $wanted_tables };
124 return [ grep { $wanted_tables_map{$_->meta->table} } @sources ];
132 croak "self has no id" unless $self->id;
133 croak "other has no id" unless $other->id;
135 my @directions = ([ 'from', 'to' ]);
136 push @directions, [ 'to', 'from' ] if $params{bidirectional};
139 foreach my $direction (@directions) {
140 my %data = ( $direction->[0] . "_table" => SL::DB::Helper::Mappings::get_table_for_package(ref($self)),
141 $direction->[0] . "_id" => $self->id,
142 $direction->[1] . "_table" => SL::DB::Helper::Mappings::get_table_for_package(ref($other)),
143 $direction->[1] . "_id" => $other->id,
146 my $link = SL::DB::Manager::RecordLink->find_by(and => [ %data ]);
147 push @links, $link ? $link : SL::DB::RecordLink->new(%data)->save;
150 return wantarray ? @links : $links[0];
153 sub sort_linked_records {
154 my ($self_or_class, $sort_by, $sort_dir, @records) = @_;
156 @records = @{ $records[0] } if (1 == scalar(@records)) && (ref($records[0]) eq 'ARRAY');
157 $sort_dir = $sort_dir * 1 ? 1 : -1;
159 my %numbers = ( 'SL::DB::SalesProcess' => sub { $_[0]->id },
160 'SL::DB::Order' => sub { $_[0]->quotation ? $_[0]->quonumber : $_[0]->ordnumber },
161 'SL::DB::DeliveryOrder' => sub { $_[0]->donumber },
162 'SL::DB::Invoice' => sub { $_[0]->invnumber },
163 'SL::DB::PurchaseInvoice' => sub { $_[0]->invnumber },
164 'SL::DB::RequirementSpec' => sub { $_[0]->id },
165 UNKNOWN => '9999999999999999',
167 my $number_xtor = sub {
168 my $number = $numbers{ ref($_[0]) };
169 $number = $number->($_[0]) if ref($number) eq 'CODE';
170 return $number || $numbers{UNKNOWN};
172 my $number_comparator = sub {
173 my $number_a = $number_xtor->($a);
174 my $number_b = $number_xtor->($b);
176 ncmp($number_a, $number_b) * $sort_dir;
180 %scores = ( 'SL::DB::SalesProcess' => 10,
181 'SL::DB::RequirementSpec' => 15,
182 'SL::DB::Order' => sub { $scores{ $_[0]->type } },
183 sales_quotation => 20,
185 sales_delivery_order => 40,
186 'SL::DB::DeliveryOrder' => sub { $scores{ $_[0]->type } },
187 'SL::DB::Invoice' => 50,
188 request_quotation => 120,
189 purchase_order => 130,
190 purchase_delivery_order => 140,
191 'SL::DB::PurchaseInvoice' => 150,
194 my $score_xtor = sub {
195 my $score = $scores{ ref($_[0]) };
196 $score = $score->($_[0]) if ref($score) eq 'CODE';
197 return $score || $scores{UNKNOWN};
199 my $type_comparator = sub {
200 my $score_a = $score_xtor->($a);
201 my $score_b = $score_xtor->($b);
203 $score_a == $score_b ? $number_comparator->() : ($score_a <=> $score_b) * $sort_dir;
206 my $today = DateTime->today_local;
207 my $date_xtor = sub {
208 $_[0]->can('transdate_as_date') ? $_[0]->transdate
209 : $_[0]->can('itime_as_date') ? $_[0]->itime->clone->truncate(to => 'day')
212 my $date_comparator = sub {
213 my $date_a = $date_xtor->($a);
214 my $date_b = $date_xtor->($b);
216 ($date_a <=> $date_b) * $sort_dir;
219 my $comparator = $sort_by eq 'number' ? $number_comparator
220 : $sort_by eq 'date' ? $date_comparator
223 return [ sort($comparator @records) ];
226 sub filter_linked_records {
227 my ($self_or_class, $filter, @records) = @_;
229 if ($filter eq 'accessible') {
230 my $employee = SL::DB::Manager::Employee->current;
231 @records = grep { !$_->can('may_be_accessed') || $_->may_be_accessed($employee) } @records;
233 croak "Unsupported filter parameter '${filter}'";
247 SL::DB::Helper::LinkedRecords - Mixin for retrieving linked records via the table C<record_links>
251 # In SL::DB::<Object>
252 use SL::DB::Helper::LinkedRecords;
254 # later in consumer code
255 # retrieve all links in both directions
256 my @linked_objects = $order->linked_records;
258 # only links to Invoices
259 my @linked_objects = $order->linked_records(
263 # more than one target
264 my @linked_objects = $order->linked_records(
265 to => [ 'Invoice', 'Order' ],
268 # more than one direction
269 my @linked_objects = $order->linked_records(
273 # more than one direction and different targets
274 my @linked_objects = $order->linked_records(
279 # transitive over known classes
280 my @linked_objects = $order->linked_records(
283 via => 'DeliveryOrder',
286 # limit direction when further params contain additional keys
287 my %params = (to => 'Invoice', from => 'Order');
288 my @linked_objects = $order->linked_records(
294 $order->link_to_record($invoice);
295 $order->link_to_record($purchase_order, bidirectional => 1);
302 =item C<linked_records %params>
304 Retrieves records linked from or to C<$self> via the table C<record_links>.
306 The optional parameter C<direction> (either C<from>, C<to> or C<both>)
307 determines whether the function retrieves records that link to C<$self> (for
308 C<direction> = C<to>) or that are linked from C<$self> (for C<direction> =
309 C<from>). For C<direction = both> all records linked from or to C<$self> are
312 The optional parameter C<from> or C<to> (same as C<direction>) contains the
313 package names of Rose models for table limitation (the prefix C<SL::DB::> is
314 optional). It can be a single model name as a single scalar or multiple model
315 names in an array reference in which case all links matching any of the model
316 names will be returned.
318 If no parameter C<direction> is given, but any of C<to>, C<from> or C<both>,
319 then C<direction> is infered accordingly. If neither are given, C<direction> is
322 The optional parameter C<via> can be used to retrieve all documents that may
323 have intermediate documents inbetween. It is an array reference of Rose package
324 names for the models that may be intermediate link targets. One example is
325 retrieving all invoices for a given quotation no matter whether or not orders
326 and delivery orders have been created. If C<via> is given then C<from> or C<to>
327 (depending on C<direction>) must be given as well, and it must then not be an
332 If you only need invoices created directly from an order C<$order> (no
333 delivery orders inbetween) then the call could look like this:
335 my $invoices = $order->linked_records(
340 Retrieving all invoices from a quotation no matter whether or not
341 orders or delivery orders where created:
343 my $invoices = $quotation->linked_records(
346 via => [ 'Order', 'DeliveryOrder' ],
349 The optional parameter C<query> can be used to limit the records
350 returned. The following call limits the earlier example to invoices
353 my $invoices = $order->linked_records(
356 query => [ transdate => DateTime->today_local ],
359 The optional parameters C<$params{sort_by}> and C<$params{sort_dir}>
360 can be used in order to sort the result. If C<$params{sort_by}> is
361 trueish then the result is sorted by calling L</sort_linked_records>.
363 The optional parameter C<$params{filter}> controls whether or not the
364 result is filtered. Supported values are:
370 Removes all objects for which the function C<may_be_accessed> from the
371 mixin L<SL::DB::Helper::MayBeAccessed> exists and returns falsish for
372 the current employee.
376 Returns an array reference. Each element returned is a Rose::DB
377 instance. Additionally several elements in the element returned are
378 set to special values:
382 =item C<_record_link_direction>
384 Either C<from> or C<to> indicating the direction. C<from> means that
385 this object is the source in the link.
387 =item C<_record_link>
389 The actual database link object (an instance of L<SL::DB::RecordLink>).
393 =item C<link_to_record $record, %params>
395 Will create an entry in the table C<record_links> with the C<from>
396 side being C<$self> and the C<to> side being C<$record>. Will only
397 insert a new entry if such a link does not already exist.
399 If C<$params{bidirectional}> is trueish then another link will be
400 created with the roles of C<from> and C<to> reversed. This link will
401 also only be created if it doesn't exist already.
403 In scalar context returns either the existing link or the newly
404 created one as an instance of C<SL::DB::RecordLink>. In array context
405 it returns an array of links (one entry if C<$params{bidirectional}>
406 is falsish and two entries if it is trueish).
408 =item C<sort_linked_records $sort_by, $sort_dir, @records>
410 Sorts linked records by C<$sort_by> in the direction given by
411 C<$sort_dir> (trueish = ascending, falsish = descending). C<@records>
412 can be either a single array reference or or normal array.
414 C<$sort_by> can be one of the following strings:
420 Sort by type first and by record number second. The type order
421 reflects the order in which records are usually processed by the
422 employees: sales processes, sales quotations, sales orders, sales
423 delivery orders, invoices; requests for quotation, purchase orders,
424 purchase delivery orders, purchase invoices.
428 Sort by the record's running number.
432 Sort by the transdate of the record was created or applies to.
434 Note: If the latter has a default setting it will always mask the creation time.
438 Returns an array reference.
440 Can only be called both as a class function since it is noe exported.
446 This mixin exports the functions L</linked_records> and
455 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>