1 use Test::More tests => 66;
10 use Support::TestSetup;
12 use Test::Deep qw(cmp_bag);
13 use List::Util qw(max);
15 use SL::DB::Buchungsgruppe;
21 use SL::DB::DeliveryOrder;
22 use SL::DB::DeliveryOrder::TypeData qw(:types);
27 my ($customer, $currency_id, $buchungsgruppe, $employee, $vendor, $taxzone);
28 my ($link, $links, $o1, $o2, $d, $i);
31 SL::DB::Manager::DeliveryOrder->delete_all(all => 1);
32 SL::DB::Manager::Order->delete_all(all => 1);
33 SL::DB::Manager::Invoice->delete_all(all => 1);
34 SL::DB::Manager::Part->delete_all(all => 1);
35 SL::DB::Manager::Customer->delete_all(all => 1);
36 SL::DB::Manager::Vendor->delete_all(all => 1);
42 $params{$_} ||= {} for qw(buchungsgruppe unit customer part tax);
46 $buchungsgruppe = SL::DB::Manager::Buchungsgruppe->find_by(description => 'Standard 19%', %{ $params{buchungsgruppe} }) || croak "No accounting group";
47 $employee = SL::DB::Manager::Employee->current || croak "No employee";
48 $taxzone = SL::DB::Manager::TaxZone->find_by( description => 'Inland') || croak "No taxzone";
50 $currency_id = $::instance_conf->get_currency_id;
52 $customer = SL::DB::Customer->new(
53 name => 'Test Customer',
54 currency_id => $currency_id,
55 taxzone_id => $taxzone->id,
56 %{ $params{customer} }
59 $vendor = SL::DB::Vendor->new(
60 name => 'Test Vendor',
61 currency_id => $currency_id,
62 taxzone_id => $taxzone->id,
70 return SL::DB::Order->new(
71 customer_id => $customer->id,
72 currency_id => $currency_id,
73 employee_id => $employee->id,
74 salesman_id => $employee->id,
75 taxzone_id => $taxzone->id,
81 sub new_delivery_order {
84 return SL::DB::DeliveryOrder->new(
85 customer_id => $customer->id,
86 currency_id => $currency_id,
87 employee_id => $employee->id,
88 salesman_id => $employee->id,
89 taxzone_id => $taxzone->id,
90 order_type => SALES_DELIVERY_ORDER_TYPE,
98 return SL::DB::Invoice->new(
99 customer_id => $customer->id,
100 currency_id => $currency_id,
101 employee_id => $employee->id,
102 salesman_id => $employee->id,
103 gldate => DateTime->today_local->to_kivitendo,
105 taxzone_id => $taxzone->id,
111 Support::TestSetup::login();
118 $link = $o1->link_to_record($i);
121 is ref $link, 'SL::DB::RecordLink', 'link_to_record returns new link';
122 is $link->from_table, 'oe', 'from_table';
123 is $link->from_id, $o1->id, 'from_id';
124 is $link->to_table, 'ar', 'to_table';
125 is $link->to_id, $i->id, 'to_id';
128 $links = $o1->linked_records;
129 is $links->[0]->id, $i->id, 'simple retrieve';
131 $links = $o1->linked_records(direction => 'to', to => 'Invoice');
132 is $links->[0]->id, $i->id, 'direct retrieve 1';
134 $links = $o1->linked_records(direction => 'to', to => 'SL::DB::Invoice');
135 is $links->[0]->id, $i->id, 'direct retrieve 2 (with SL::DB::)';
137 $links = $o1->linked_records(direction => 'to', to => [ 'Invoice', 'Order' ]);
138 is $links->[0]->id, $i->id, 'direct retrieve 3 (array target)';
140 $links = $o1->linked_records(direction => 'both', both => 'Invoice');
141 is $links->[0]->id, $i->id, 'direct retrieve 4 (direction both)';
143 $links = $i->linked_records(direction => 'from', from => 'Order');
144 is $links->[0]->id, $o1->id, 'direct retrieve 4 (direction from)';
146 # what happens if we delete a linked record?
149 $links = $i->linked_records(direction => 'from', from => 'Order');
150 is @$links, 0, 'no dangling link after delete';
152 # can we distinguish between types?
153 $o1 = new_order(quotation => 1);
155 $o1->link_to_record($o2);
157 $links = $o2->linked_records(direction => 'from', from => 'Order', query => [ quotation => 1 ]);
158 is $links->[0]->id, $o1->id, 'query restricted retrieve 1';
160 $links = $o2->linked_records(direction => 'from', from => 'Order', query => [ quotation => 0 ]);
161 is @$links, 0, 'query restricted retrieve 2';
163 # try bidirectional linking
166 $o1->link_to_record($o2, bidirectional => 1);
168 $links = $o1->linked_records(direction => 'to', to => 'Order');
169 is $links->[0]->id, $o2->id, 'bidi 1';
170 $links = $o1->linked_records(direction => 'from', from => 'Order');
171 is $links->[0]->id, $o2->id, 'bidi 2';
172 $links = $o1->linked_records(direction => 'both', both => 'Order');
173 is $links->[0]->id, $o2->id, 'bidi 3';
175 # funky stuff with both
177 $d = new_delivery_order();
180 $o2->link_to_record($d);
181 $d->link_to_record($i);
182 # at this point the structure is:
184 # o1 <--> o2 ---> d ---> i
187 $links = $d->linked_records(direction => 'both', to => 'Invoice', from => 'Order', sort_by => 'customer_id', sort_dir => 1);
188 is $links->[0]->id, $o2->id, 'both with different from/to 1';
189 is $links->[1]->id, $i->id, 'both with different from/to 2';
191 # what happens if we double link?
193 $o2->link_to_record($d);
195 $links = $o2->linked_records(direction => 'to', to => 'DeliveryOrder');
196 is @$links, 1, 'double link is only added once 1';
198 $d->link_to_record($o2, bidirectional => 1);
199 # at this point the structure is:
201 # o1 <--> o2 <--> d ---> i
204 $links = $o2->linked_records(direction => 'to', to => 'DeliveryOrder');
205 is @$links, 1, 'double link is only added once 2';
207 # doc states that to/from ae optional. test that
208 $links = $o2->linked_records(direction => 'both');
209 is @$links, 2, 'links without from/to get all';
211 # doc states you can limit with direction when giving excess params
212 $links = $d->linked_records(direction => 'to', to => 'Invoice', from => 'Order');
213 is $links->[0]->id, $i->id, 'direction to limit params 1';
214 is @$links, 1, 'direction to limit params 2';
216 # doc says there will be special values set... lets see
217 $links = $o1->linked_records(direction => 'to', to => 'Order');
218 is $links->[0]->{_record_link_direction}, 'to', '_record_link_direction to';
219 is $links->[0]->{_record_link}->to_id, $o2->id, '_record_link to';
221 $links = $o1->linked_records(direction => 'from', from => 'Order');
222 is $links->[0]->{_record_link_direction}, 'from', '_record_link_direction from';
223 is $links->[0]->{_record_link}->to_id, $o1->id, '_record_link from';
225 # check if bidi returns an array of links even if aready existing
226 my @links = $d->link_to_record($o2, bidirectional => 1);
227 # at this point the structure is:
229 # o1 <--> o2 <--> d ---> i
231 is @links, 2, 'bidi returns array of links in array context';
234 $links = $o2->linked_records(direction => 'to', to => 'Invoice', via => 'DeliveryOrder');
235 is $links->[0]->id, $i->id, 'simple case via links (string)';
237 $links = $o2->linked_records(direction => 'to', to => 'Invoice', via => [ 'DeliveryOrder' ]);
238 is $links->[0]->id, $i->id, 'simple case via links (arrayref)';
240 $links = $o1->linked_records(direction => 'to', to => 'Invoice', via => [ 'Order', 'DeliveryOrder' ]);
241 is $links->[0]->id, $i->id, 'simple case via links (2 hops)';
243 # multiple links in the same direction from one object
244 $o1->link_to_record($d);
245 # at this point the structure is:
247 # o1 <--> o2 <--> d ---> i
251 $links = $o2->linked_records(direction => 'to', to => 'Invoice', via => 'DeliveryOrder');
252 is $links->[0]->id, $i->id, 'simple case via links (string)';
255 # o1 must have 2 linked records now:
256 $links = $o1->linked_records(direction => 'to');
257 is @$links, 2, 'more than one link';
259 # as a special funny case, o1 via Order, Order will now yield o2, because it bounces back over itself
260 { local $TODO = 'no idea if this is desired';
261 $links = $o2->linked_records(direction => 'to', to => 'Order', via => [ 'Order', 'Order' ]);
262 is @$links, 2, 'via links with bidirectional hop over starting object';
265 # for sorting, get all don't bother with the links, we'll just take our records
266 my @records = ($o2, $i, $o1, $d);
268 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('type', 1, @records);
269 is_deeply $sorted, [$o1, $o2, $d, $i], 'sorting by type';
270 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('type', 0, @records);
271 is_deeply $sorted, [$i, $d, $o2, $o1], 'sorting by type desc';
278 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('number', 1, @records);
279 is_deeply $sorted, [$d, $o1, $i, $o2], 'sorting by number';
280 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('number', 0, @records);
281 is_deeply $sorted, [$o2, $i, $o1, $d], 'sorting by number desc';
283 # again with natural sorting
285 $o1->ordnumber("a3");
287 $o2->ordnumber("a10");
289 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('number', 1, @records);
290 is_deeply $sorted, [$d, $o1, $i, $o2], 'sorting naturally by number';
291 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('number', 0, @records);
292 is_deeply $sorted, [$o2, $i, $o1, $d], 'sorting naturally by number desc';
294 $o2->transdate(DateTime->new(year => 2010, month => 3, day => 1));
295 $i->transdate(DateTime->new(year => 2014, month => 3, day => 19));
296 $o1->transdate(DateTime->new(year => 2014, month => 5, day => 1));
297 $d->transdate(DateTime->new(year => 2014, month => 5, day => 2));
299 # transdate should be used before itime
300 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('date', 1, @records);
301 is_deeply $sorted, [$o2, $i, $o1, $d], 'sorting by transdate';
302 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('date', 0, @records);
303 is_deeply $sorted, [$d, $o1, $i, $o2], 'sorting by transdate desc';
305 # now recursive stuff 2, with backlinks
306 $links = $o1->linked_records(direction => 'to', recursive => 1, save_path => 1);
307 is @$links, 4, 'recursive finds all 4 (backlink to self because of bidi o1<->o2)';
309 # because of the link o1->d the longest path should be legth 2. test that
310 is max(map { $_->{_record_link_depth} } @$links), 2, 'longest path is 2';
312 $links = $o2->linked_records(direction => 'to', recursive => 1);
313 is @$links, 4, 'recursive from o2 finds 4';
315 $links = $o1->linked_records(direction => 'from', recursive => 1, save_path => 1);
316 is @$links, 3, 'recursive from o1 finds 3 (not i)';
318 $links = $i->linked_records(direction => 'from', recursive => 1, save_path => 1);
319 is @$links, 3, 'recursive from i finds 3 (not i)';
321 $links = $o1->linked_records(direction => 'both', recursive => 1, save_path => 1);
322 is @$links, 4, 'recursive dir=both does not give duplicates';
334 my $i1 = new_invoice();
335 my $i2 = new_invoice();
337 $o1->link_to_record($i1);
338 $o2->link_to_record($i2);
340 $links = $o1->linked_records(direction => 'to', to => 'Invoice', batch => [ $o1->id, $o2->id ]);
341 is_deeply [ map { $_->id } @$links ], [ $i1->id , $i2->id ], "batch works";
343 $links = $o1->linked_records(direction => 'to', recursive => 1, batch => [ $o1->id, $o2->id ]);
344 cmp_bag [ map { $_->id } @$links ], [ $i1->id , $i2->id ], "batch works recursive";
346 $links = $o1->linked_records(direction => 'to', to => 'Invoice', batch => [ $o1->id, $o2->id ], by_id => 1);
347 # $::lxdebug->dump(0, "links", $links);
348 is @{ $links->{$o1->id} }, 1, "batch by_id 1";
349 is @{ $links->{$o2->id} }, 1, "batch by_id 2";
350 is keys %$links, 2, "batch by_id 3";
351 is $links->{$o1->id}[0]->id, $i1->id, "batch by_id 4";
352 is $links->{$o2->id}[0]->id, $i2->id, "batch by_id 5";
354 $links = $o1->linked_records(direction => 'to', recursive => 1, batch => [ $o1->id, $o2->id ], by_id => 1);
355 is @{ $links->{$o1->id} }, 1, "batch recursive by_id 1";
356 is @{ $links->{$o2->id} }, 1, "batch recursive by_id 2";
357 is keys %$links, 2, "batch recursive by_id 3";
358 is $links->{$o1->id}[0]->id, $i1->id, "batch recursive by_id 4";
359 is $links->{$o2->id}[0]->id, $i2->id, "batch recursive by_id 5";
361 $links = $o1->linked_records(direction => 'both', recursive => 1, batch => [ $o1->id, $o2->id ], by_id => 1);
362 is @{ $links->{$o1->id} }, 1, "batch recursive by_id direction both 1";
363 is @{ $links->{$o2->id} }, 1, "batch recursive by_id direction both 2";
364 is keys %$links, 2, "batch recursive by_id direction both 3";
365 is $links->{$o1->id}[0]->id, $i1->id, "batch recursive by_id direction both 4";
366 is $links->{$o2->id}[0]->id, $i2->id, "batch recursive by_id direction both 5";