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_as_date
197 : $_[0]->can('itime_as_date') ? $_[0]->itime_as_date
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>
241 =item C<linked_records %params>
243 Retrieves records linked from or to C<$self> via the table
244 C<record_links>. The mandatory parameter C<direction> (either C<from>,
245 C<to> or C<both>) determines whether the function retrieves records
246 that link to C<$self> (for C<direction> = C<to>) or that are linked
247 from C<$self> (for C<direction> = C<from>). For C<direction = both>
248 all records linked from or to C<$self> are returned.
250 The optional parameter C<from> or C<to> (same as C<direction>)
251 contains the package names of Rose models for table limitation (the
252 prefix C<SL::DB::> is optional). It can be a single model name as a
253 single scalar or multiple model names in an array reference in which
254 case all links matching any of the model names will be returned.
256 The optional parameter C<via> can be used to retrieve all documents
257 that may have intermediate documents inbetween. It is an array
258 reference of Rose package names for the models that may be
259 intermediate link targets. One example is retrieving all invoices for
260 a given quotation no matter whether or not orders and delivery orders
261 have been created. If C<via> is given then C<from> or C<to> (depending
262 on C<direction>) must be given as well, and it must then not be an
267 If you only need invoices created directly from an order C<$order> (no
268 delivery orders inbetween) then the call could look like this:
270 my $invoices = $order->linked_records(direction => 'to',
273 Retrieving all invoices from a quotation no matter whether or not
274 orders or delivery orders where created:
276 my $invoices = $quotation->linked_records(direction => 'to',
278 via => [ 'Order', 'DeliveryOrder' ]);
280 The optional parameter C<query> can be used to limit the records
281 returned. The following call limits the earlier example to invoices
284 my $invoices = $order->linked_records(direction => 'to',
286 query => [ transdate => DateTime->today_local ]);
288 The optional parameters C<$params{sort_by}> and C<$params{sort_dir}>
289 can be used in order to sort the result. If C<$params{sort_by}> is
290 trueish then the result is sorted by calling L</sort_linked_records>.
292 The optional parameter C<$params{filter}> controls whether or not the
293 result is filtered. Supported values are:
299 Removes all objects for which the function C<may_be_accessed> from the
300 mixin L<SL::DB::Helper::MayBeAccessed> exists and returns falsish for
301 the current employee.
305 Returns an array reference. Each element returned is a Rose::DB
306 instance. Additionally several elements in the element returned are
307 set to special values:
311 =item C<_record_link_direction>
313 Either C<from> or C<to> indicating the direction. C<from> means that
314 this object is the source in the link.
316 =item C<_record_link>
318 The actual database link object (an instance of L<SL::DB::RecordLink>).
322 =item C<link_to_record $record, %params>
324 Will create an entry in the table C<record_links> with the C<from>
325 side being C<$self> and the C<to> side being C<$record>. Will only
326 insert a new entry if such a link does not already exist.
328 If C<$params{bidirectional}> is trueish then another link will be
329 created with the roles of C<from> and C<to> reversed. This link will
330 also only be created if it doesn't exist already.
332 In scalar contenxt returns either the existing link or the newly
333 created one as an instance of C<SL::DB::RecordLink>. In array context
334 it returns an array of links (one entry if C<$params{bidirectional}>
335 is falsish and two entries if it is trueish).
337 =item C<sort_linked_records $sort_by, $sort_dir, @records>
339 Sorts linked records by C<$sort_by> in the direction given by
340 C<$sort_dir> (trueish = ascending, falsish = descending). C<@records>
341 can be either a single array reference or or normal array.
343 C<$sort_by> can be one of the following strings:
349 Sort by type first and by record number second. The type order
350 reflects the order in which records are usually processed by the
351 employees: sales processes, sales quotations, sales orders, sales
352 delivery orders, invoices; requests for quotation, purchase orders,
353 purchase delivery orders, purchase invoices.
357 Sort by the record's running number.
361 Sort by the date the record was created or applies to.
365 Returns a hash reference.
367 Can be called both as a class or as an instance function.
369 This function is not exported.
375 This mixin exports the functions L</linked_records> and
384 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>