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 ];
48 my $myself = $wanted eq 'from' ? 'to' : $wanted eq 'to' ? 'from' : croak("Invalid parameter `direction'");
50 my $my_table = SL::DB::Helper::Mappings::get_table_for_package(ref($self));
52 my @query = ( "${myself}_table" => $my_table,
53 "${myself}_id" => $self->id );
55 if ($params{$wanted}) {
56 my $wanted_classes = ref($params{$wanted}) eq 'ARRAY' ? $params{$wanted} : [ $params{$wanted} ];
57 my $wanted_tables = [ map { SL::DB::Helper::Mappings::get_table_for_package($_) || croak("Invalid parameter `${wanted}'") } @{ $wanted_classes } ];
58 push @query, ("${wanted}_table" => $wanted_tables);
61 my $links = SL::DB::Manager::RecordLink->get_all(query => [ and => \@query ]);
63 my $sub_wanted_table = "${wanted}_table";
64 my $sub_wanted_id = "${wanted}_id";
67 @query = ref($params{query}) eq 'ARRAY' ? @{ $params{query} } : ();
69 foreach my $link (@{ $links }) {
70 my $manager_class = SL::DB::Helper::Mappings::get_manager_package_for_table($link->$sub_wanted_table);
71 my $object_class = SL::DB::Helper::Mappings::get_package_for_table($link->$sub_wanted_table);
72 eval "require " . $object_class . "; 1;";
73 push @{ $records }, @{ $manager_class->get_all(query => [ id => $link->$sub_wanted_id, @query ]) };
84 croak "self has no id" unless $self->id;
85 croak "other has no id" unless $other->id;
87 my @directions = ([ 'from', 'to' ]);
88 push @directions, [ 'to', 'from' ] if $params{bidirectional};
91 foreach my $direction (@directions) {
92 my %data = ( $direction->[0] . "_table" => SL::DB::Helper::Mappings::get_table_for_package(ref($self)),
93 $direction->[0] . "_id" => $self->id,
94 $direction->[1] . "_table" => SL::DB::Helper::Mappings::get_table_for_package(ref($other)),
95 $direction->[1] . "_id" => $other->id,
98 my $link = SL::DB::Manager::RecordLink->find_by(and => [ %data ]);
99 push @links, $link ? $link : SL::DB::RecordLink->new(%data)->save unless $link;
102 return wantarray ? @links : $links[0];
105 sub sort_linked_records {
106 my ($self_or_class, $sort_by, $sort_dir, @records) = @_;
108 @records = @{ $records[0] } if (1 == scalar(@records)) && (ref($records[0]) eq 'ARRAY');
109 $sort_dir = $sort_dir * 1 ? 1 : -1;
111 my %numbers = ( 'SL::DB::SalesProcess' => sub { $_[0]->id },
112 'SL::DB::Order' => sub { $_[0]->quotation ? $_[0]->quonumber : $_[0]->ordnumber },
113 'SL::DB::DeliveryOrder' => sub { $_[0]->donumber },
114 'SL::DB::Invoice' => sub { $_[0]->invnumber },
115 'SL::DB::PurchaseInvoice' => sub { $_[0]->invnumber },
116 UNKNOWN => '9999999999999999',
118 my $number_xtor = sub {
119 my $number = $numbers{ ref($_[0]) };
120 $number = $number->($_[0]) if ref($number) eq 'CODE';
121 return $number || $numbers{UNKNOWN};
123 my $number_comparator = sub {
124 my $number_a = $number_xtor->($a);
125 my $number_b = $number_xtor->($b);
127 ncmp($number_a, $number_b) * $sort_dir;
131 %scores = ( 'SL::DB::SalesProcess' => 10,
132 'SL::DB::Order' => sub { $scores{ $_[0]->type } },
133 sales_quotation => 20,
135 sales_delivery_order => 40,
136 'SL::DB::DeliveryOrder' => sub { $scores{ $_[0]->type } },
137 'SL::DB::Invoice' => 50,
138 request_quotation => 120,
139 purchase_order => 130,
140 purchase_delivery_order => 140,
141 'SL::DB::PurchaseInvoice' => 150,
144 my $score_xtor = sub {
145 my $score = $scores{ ref($_[0]) };
146 $score = $score->($_[0]) if ref($score) eq 'CODE';
147 return $score || $scores{UNKNOWN};
149 my $type_comparator = sub {
150 my $score_a = $score_xtor->($a);
151 my $score_b = $score_xtor->($b);
153 $score_a == $score_b ? $number_comparator->() : ($score_a <=> $score_b) * $sort_dir;
156 my $today = DateTime->today_local;
157 my $date_xtor = sub {
158 $_[0]->can('transdate_as_date') ? $_[0]->transdate_as_date
159 : $_[0]->can('itime_as_date') ? $_[0]->itime_as_date
162 my $date_comparator = sub {
163 my $date_a = $date_xtor->($a);
164 my $date_b = $date_xtor->($b);
166 ($date_a <=> $date_b) * $sort_dir;
169 my $comparator = $sort_by eq 'number' ? $number_comparator
170 : $sort_by eq 'date' ? $date_comparator
173 return [ sort($comparator @records) ];
176 sub filter_linked_records {
177 my ($self_or_class, $filter, @records) = @_;
179 if ($filter eq 'accessible') {
180 my $employee = SL::DB::Manager::Employee->current;
181 @records = grep { !$_->can('may_be_accessed') || $_->may_be_accessed($employee) } @records;
183 croak "Unsupported filter parameter '${filter}'";
197 SL::DB::Helper::LinkedRecords - Mixin for retrieving linked records via the table C<record_links>
203 =item C<linked_records %params>
205 Retrieves records linked from or to C<$self> via the table
206 C<record_links>. The mandatory parameter C<direction> (either C<from>,
207 C<to> or C<both>) determines whether the function retrieves records
208 that link to C<$self> (for C<direction> = C<to>) or that are linked
209 from C<$self> (for C<direction> = C<from>). For C<direction = both>
210 all records linked from or to C<$self> are returned.
212 The optional parameter C<from> or C<to> (same as C<direction>)
213 contains the package names of Rose models for table limitation. It can
214 be a single model name as a single scalar or multiple model names in
215 an array reference in which case all links matching any of the model
216 names will be returned.
218 If you only need invoices created from an order C<$order> then the
219 call could look like this:
221 my $invoices = $order->linked_records(direction => 'to',
222 to => 'SL::DB::Invoice');
224 The optional parameter C<query> can be used to limit the records
225 returned. The following call limits the earlier example to invoices
228 my $invoices = $order->linked_records(direction => 'to',
229 to => 'SL::DB::Invoice',
230 query => [ transdate => DateTime->today_local ]);
232 The optional parameters C<$params{sort_by}> and C<$params{sort_dir}>
233 can be used in order to sort the result. If C<$params{sort_by}> is
234 trueish then the result is sorted by calling L</sort_linked_records>.
236 The optional parameter C<$params{filter}> controls whether or not the
237 result is filtered. Supported values are:
243 Removes all objects for which the function C<may_be_accessed> from the
244 mixin L<SL::DB::Helper::MayBeAccessed> exists and returns falsish for
245 the current employee.
249 Returns an array reference.
251 =item C<link_to_record $record, %params>
253 Will create an entry in the table C<record_links> with the C<from>
254 side being C<$self> and the C<to> side being C<$record>. Will only
255 insert a new entry if such a link does not already exist.
257 If C<$params{bidirectional}> is trueish then another link will be
258 created with the roles of C<from> and C<to> reversed. This link will
259 also only be created if it doesn't exist already.
261 In scalar contenxt returns either the existing link or the newly
262 created one as an instance of C<SL::DB::RecordLink>. In array context
263 it returns an array of links (one entry if C<$params{bidirectional}>
264 is falsish and two entries if it is trueish).
266 =item C<sort_linked_records $sort_by, $sort_dir, @records>
268 Sorts linked records by C<$sort_by> in the direction given by
269 C<$sort_dir> (trueish = ascending, falsish = descending). C<@records>
270 can be either a single array reference or or normal array.
272 C<$sort_by> can be one of the following strings:
278 Sort by type first and by record number second. The type order
279 reflects the order in which records are usually processed by the
280 employees: sales processes, sales quotations, sales orders, sales
281 delivery orders, invoices; requests for quotation, purchase orders,
282 purchase delivery orders, purchase invoices.
286 Sort by the record's running number.
290 Sort by the date the record was created or applies to.
294 Returns a hash reference.
296 Can be called both as a class or as an instance function.
298 This function is not exported.
304 This mixin exports the functions L</linked_records> and
313 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>