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} || croak("Missing parameter `direction'");
35 if ($wanted eq 'both') {
36 my $both = delete($params{both});
37 my %from_to = ( from => delete($params{from}) || $both,
38 to => delete($params{to}) || $both);
40 my @records = (@{ _linked_records_implementation($self, %params, direction => 'from', from => $from_to{from}) },
41 @{ _linked_records_implementation($self, %params, direction => 'to', to => $from_to{to} ) });
43 my %record_map = map { ( ref($_) . $_->id => $_ ) } @records;
45 return [ values %record_map ];
49 croak("Cannot use 'via' without '${wanted}_table'") if !$params{$wanted};
50 croak("Cannot use 'via' with '${wanted}_table' being an array") if ref $params{$wanted};
53 my $myself = $wanted eq 'from' ? 'to' : $wanted eq 'to' ? 'from' : croak("Invalid parameter `direction'");
54 my $my_table = SL::DB::Helper::Mappings::get_table_for_package(ref($self));
56 my $sub_wanted_table = "${wanted}_table";
57 my $sub_wanted_id = "${wanted}_id";
59 my ($wanted_classes, $wanted_tables);
60 if ($params{$wanted}) {
61 $wanted_classes = ref($params{$wanted}) eq 'ARRAY' ? $params{$wanted} : [ $params{$wanted} ];
62 $wanted_tables = [ map { SL::DB::Helper::Mappings::get_table_for_package($_) || croak("Invalid parameter `${wanted}'") } @{ $wanted_classes } ];
65 my @get_objects_query = ref($params{query}) eq 'ARRAY' ? @{ $params{query} } : ();
66 my $get_objects = sub {
68 my $manager_class = SL::DB::Helper::Mappings::get_manager_package_for_table($link->$sub_wanted_table);
69 my $object_class = SL::DB::Helper::Mappings::get_package_for_table($link->$sub_wanted_table);
70 eval "require " . $object_class . "; 1;";
72 $_->{_record_link_direction} = $wanted;
73 $_->{_record_link} = $link;
75 } @{ $manager_class->get_all(query => [ id => $link->$sub_wanted_id, @get_objects_query ]) };
78 # If no 'via' is given then use a simple(r) method for querying the wanted objects.
80 my @query = ( "${myself}_table" => $my_table,
81 "${myself}_id" => $self->id );
82 push @query, ( "${wanted}_table" => $wanted_tables ) if $wanted_tables;
84 return [ map { $get_objects->($_) } @{ SL::DB::Manager::RecordLink->get_all(query => [ and => \@query ]) } ];
87 # More complex handling for the 'via' case.
88 my @sources = ( $self );
89 my @targets = map { SL::DB::Helper::Mappings::get_table_for_package($_) } @{ ref($params{via}) ? $params{via} : [ $params{via} ] };
90 push @targets, @{ $wanted_tables } if $wanted_tables;
92 my %seen = map { ($_->meta->table . $_->id => 1) } @sources;
95 my @new_sources = @sources;
96 foreach my $src (@sources) {
97 my @query = ( "${myself}_table" => $src->meta->table,
98 "${myself}_id" => $src->id,
99 "${wanted}_table" => \@targets );
101 map { $get_objects->($_) }
102 grep { !$seen{$_->$sub_wanted_table . $_->$sub_wanted_id} }
103 @{ SL::DB::Manager::RecordLink->get_all(query => [ and => \@query ]) };
106 @sources = @new_sources;
107 %seen = map { ($_->meta->table . $_->id => 1) } @sources;
111 my %wanted_tables_map = map { ($_ => 1) } @{ $wanted_tables };
112 return [ grep { $wanted_tables_map{$_->meta->table} } @sources ];
120 croak "self has no id" unless $self->id;
121 croak "other has no id" unless $other->id;
123 my @directions = ([ 'from', 'to' ]);
124 push @directions, [ 'to', 'from' ] if $params{bidirectional};
127 foreach my $direction (@directions) {
128 my %data = ( $direction->[0] . "_table" => SL::DB::Helper::Mappings::get_table_for_package(ref($self)),
129 $direction->[0] . "_id" => $self->id,
130 $direction->[1] . "_table" => SL::DB::Helper::Mappings::get_table_for_package(ref($other)),
131 $direction->[1] . "_id" => $other->id,
134 my $link = SL::DB::Manager::RecordLink->find_by(and => [ %data ]);
135 push @links, $link ? $link : SL::DB::RecordLink->new(%data)->save unless $link;
138 return wantarray ? @links : $links[0];
141 sub sort_linked_records {
142 my ($self_or_class, $sort_by, $sort_dir, @records) = @_;
144 @records = @{ $records[0] } if (1 == scalar(@records)) && (ref($records[0]) eq 'ARRAY');
145 $sort_dir = $sort_dir * 1 ? 1 : -1;
147 my %numbers = ( 'SL::DB::SalesProcess' => sub { $_[0]->id },
148 'SL::DB::Order' => sub { $_[0]->quotation ? $_[0]->quonumber : $_[0]->ordnumber },
149 'SL::DB::DeliveryOrder' => sub { $_[0]->donumber },
150 'SL::DB::Invoice' => sub { $_[0]->invnumber },
151 'SL::DB::PurchaseInvoice' => sub { $_[0]->invnumber },
152 'SL::DB::RequirementSpec' => sub { $_[0]->id },
153 UNKNOWN => '9999999999999999',
155 my $number_xtor = sub {
156 my $number = $numbers{ ref($_[0]) };
157 $number = $number->($_[0]) if ref($number) eq 'CODE';
158 return $number || $numbers{UNKNOWN};
160 my $number_comparator = sub {
161 my $number_a = $number_xtor->($a);
162 my $number_b = $number_xtor->($b);
164 ncmp($number_a, $number_b) * $sort_dir;
168 %scores = ( 'SL::DB::SalesProcess' => 10,
169 'SL::DB::RequirementSpec' => 15,
170 'SL::DB::Order' => sub { $scores{ $_[0]->type } },
171 sales_quotation => 20,
173 sales_delivery_order => 40,
174 'SL::DB::DeliveryOrder' => sub { $scores{ $_[0]->type } },
175 'SL::DB::Invoice' => 50,
176 request_quotation => 120,
177 purchase_order => 130,
178 purchase_delivery_order => 140,
179 'SL::DB::PurchaseInvoice' => 150,
182 my $score_xtor = sub {
183 my $score = $scores{ ref($_[0]) };
184 $score = $score->($_[0]) if ref($score) eq 'CODE';
185 return $score || $scores{UNKNOWN};
187 my $type_comparator = sub {
188 my $score_a = $score_xtor->($a);
189 my $score_b = $score_xtor->($b);
191 $score_a == $score_b ? $number_comparator->() : ($score_a <=> $score_b) * $sort_dir;
194 my $today = DateTime->today_local;
195 my $date_xtor = sub {
196 $_[0]->can('transdate_as_date') ? $_[0]->transdate
197 : $_[0]->can('itime_as_date') ? $_[0]->itime->clone->truncate(to => 'day')
200 my $date_comparator = sub {
201 my $date_a = $date_xtor->($a);
202 my $date_b = $date_xtor->($b);
204 ($date_a <=> $date_b) * $sort_dir;
207 my $comparator = $sort_by eq 'number' ? $number_comparator
208 : $sort_by eq 'date' ? $date_comparator
211 return [ sort($comparator @records) ];
214 sub filter_linked_records {
215 my ($self_or_class, $filter, @records) = @_;
217 if ($filter eq 'accessible') {
218 my $employee = SL::DB::Manager::Employee->current;
219 @records = grep { !$_->can('may_be_accessed') || $_->may_be_accessed($employee) } @records;
221 croak "Unsupported filter parameter '${filter}'";
235 SL::DB::Helper::LinkedRecords - Mixin for retrieving linked records via the table C<record_links>
239 # In SL::DB::<Object>
240 use SL::DB::Helper::LinkedRecords;
242 # later in consumer code
244 my @linked_objects = $order->linked_records(
248 # only links to Invoices
249 my @linked_objects = $order->linked_records(
254 # more than one target
255 my @linked_objects = $order->linked_records(
257 to => [ 'Invoice', 'Order' ],
260 # more than one direction
261 my @linked_objects = $order->linked_records(
266 # more than one direction and different targets
267 my @linked_objects = $order->linked_records(
273 # transitive over known classes
274 my @linked_objects = $order->linked_records(
277 via => 'DeliveryOrder',
281 $order->link_to_record($invoice);
282 $order->link_to_record($purchase_order, bidirectional => 1);
289 =item C<linked_records %params>
291 Retrieves records linked from or to C<$self> via the table C<record_links>. The
292 mandatory parameter C<direction> (either C<from>, C<to> or C<both>) determines
293 whether the function retrieves records that link to C<$self> (for C<direction>
294 = C<to>) or that are linked from C<$self> (for C<direction> = C<from>). For
295 C<direction = both> all records linked from or to C<$self> are returned.
297 The optional parameter C<from> or C<to> (same as C<direction>) contains the
298 package names of Rose models for table limitation (the prefix C<SL::DB::> is
299 optional). It can be a single model name as a single scalar or multiple model
300 names in an array reference in which case all links matching any of the model
301 names will be returned.
303 The optional parameter C<via> can be used to retrieve all documents that may
304 have intermediate documents inbetween. It is an array reference of Rose package
305 names for the models that may be intermediate link targets. One example is
306 retrieving all invoices for a given quotation no matter whether or not orders
307 and delivery orders have been created. If C<via> is given then C<from> or C<to>
308 (depending on C<direction>) must be given as well, and it must then not be an
313 If you only need invoices created directly from an order C<$order> (no
314 delivery orders inbetween) then the call could look like this:
316 my $invoices = $order->linked_records(
321 Retrieving all invoices from a quotation no matter whether or not
322 orders or delivery orders where created:
324 my $invoices = $quotation->linked_records(
327 via => [ 'Order', 'DeliveryOrder' ],
330 The optional parameter C<query> can be used to limit the records
331 returned. The following call limits the earlier example to invoices
334 my $invoices = $order->linked_records(
337 query => [ transdate => DateTime->today_local ],
340 The optional parameters C<$params{sort_by}> and C<$params{sort_dir}>
341 can be used in order to sort the result. If C<$params{sort_by}> is
342 trueish then the result is sorted by calling L</sort_linked_records>.
344 The optional parameter C<$params{filter}> controls whether or not the
345 result is filtered. Supported values are:
351 Removes all objects for which the function C<may_be_accessed> from the
352 mixin L<SL::DB::Helper::MayBeAccessed> exists and returns falsish for
353 the current employee.
357 Returns an array reference. Each element returned is a Rose::DB
358 instance. Additionally several elements in the element returned are
359 set to special values:
363 =item C<_record_link_direction>
365 Either C<from> or C<to> indicating the direction. C<from> means that
366 this object is the source in the link.
368 =item C<_record_link>
370 The actual database link object (an instance of L<SL::DB::RecordLink>).
374 =item C<link_to_record $record, %params>
376 Will create an entry in the table C<record_links> with the C<from>
377 side being C<$self> and the C<to> side being C<$record>. Will only
378 insert a new entry if such a link does not already exist.
380 If C<$params{bidirectional}> is trueish then another link will be
381 created with the roles of C<from> and C<to> reversed. This link will
382 also only be created if it doesn't exist already.
384 In scalar context returns either the existing link or the newly
385 created one as an instance of C<SL::DB::RecordLink>. In array context
386 it returns an array of links (one entry if C<$params{bidirectional}>
387 is falsish and two entries if it is trueish).
389 =item C<sort_linked_records $sort_by, $sort_dir, @records>
391 Sorts linked records by C<$sort_by> in the direction given by
392 C<$sort_dir> (trueish = ascending, falsish = descending). C<@records>
393 can be either a single array reference or or normal array.
395 C<$sort_by> can be one of the following strings:
401 Sort by type first and by record number second. The type order
402 reflects the order in which records are usually processed by the
403 employees: sales processes, sales quotations, sales orders, sales
404 delivery orders, invoices; requests for quotation, purchase orders,
405 purchase delivery orders, purchase invoices.
409 Sort by the record's running number.
413 Sort by the transdate of the record was created or applies to.
415 Note: If the latter has a default setting it will always mask the creation time.
419 Returns an array reference.
421 Can only be called both as a class function since it is noe exported.
427 This mixin exports the functions L</linked_records> and
436 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>