1 use Test::More tests => 49;
10 use Support::TestSetup;
12 use List::Util qw(max);
14 use SL::DB::Buchungsgruppe;
20 use SL::DB::DeliveryOrder;
25 my ($customer, $currency_id, $buchungsgruppe, $employee, $vendor, $taxzone);
26 my ($link, $links, $o1, $o2, $d, $i);
31 $params{$_} ||= {} for qw(buchungsgruppe unit customer part tax);
33 SL::DB::Manager::DeliveryOrder->delete_all(all => 1);
34 SL::DB::Manager::Order->delete_all(all => 1);
35 SL::DB::Manager::Invoice->delete_all(all => 1);
36 SL::DB::Manager::Customer->delete_all(all => 1);
37 SL::DB::Manager::Vendor->delete_all(all => 1);
39 $buchungsgruppe = SL::DB::Manager::Buchungsgruppe->find_by(description => 'Standard 19%', %{ $params{buchungsgruppe} }) || croak "No accounting group";
40 $employee = SL::DB::Manager::Employee->current || croak "No employee";
41 $taxzone = SL::DB::Manager::TaxZone->find_by( description => 'Inland') || croak "No taxzone";
43 $currency_id = $::instance_conf->get_currency_id;
45 $customer = SL::DB::Customer->new(
46 name => 'Test Customer',
47 currency_id => $currency_id,
48 taxzone_id => $taxzone->id,
49 %{ $params{customer} }
52 $vendor = SL::DB::Vendor->new(
53 name => 'Test Vendor',
54 currency_id => $currency_id,
55 taxzone_id => $taxzone->id,
63 return SL::DB::Order->new(
64 customer_id => $customer->id,
65 currency_id => $currency_id,
66 employee_id => $employee->id,
67 salesman_id => $employee->id,
68 taxzone_id => $taxzone->id,
74 sub new_delivery_order {
77 return SL::DB::DeliveryOrder->new(
78 customer_id => $customer->id,
79 currency_id => $currency_id,
80 employee_id => $employee->id,
81 salesman_id => $employee->id,
82 taxzone_id => $taxzone->id,
90 return SL::DB::Invoice->new(
91 customer_id => $customer->id,
92 currency_id => $currency_id,
93 employee_id => $employee->id,
94 salesman_id => $employee->id,
95 gldate => DateTime->today_local->to_kivitendo,
97 taxzone_id => $taxzone->id,
103 Support::TestSetup::login();
111 $link = $o1->link_to_record($i);
114 is ref $link, 'SL::DB::RecordLink', 'link_to_record returns new link';
115 is $link->from_table, 'oe', 'from_table';
116 is $link->from_id, $o1->id, 'from_id';
117 is $link->to_table, 'ar', 'to_table';
118 is $link->to_id, $i->id, 'to_id';
121 $links = $o1->linked_records;
122 is $links->[0]->id, $i->id, 'simple retrieve';
124 $links = $o1->linked_records(direction => 'to', to => 'Invoice');
125 is $links->[0]->id, $i->id, 'direct retrieve 1';
127 $links = $o1->linked_records(direction => 'to', to => 'SL::DB::Invoice');
128 is $links->[0]->id, $i->id, 'direct retrieve 2 (with SL::DB::)';
130 $links = $o1->linked_records(direction => 'to', to => [ 'Invoice', 'Order' ]);
131 is $links->[0]->id, $i->id, 'direct retrieve 3 (array target)';
133 $links = $o1->linked_records(direction => 'both', both => 'Invoice');
134 is $links->[0]->id, $i->id, 'direct retrieve 4 (direction both)';
136 $links = $i->linked_records(direction => 'from', from => 'Order');
137 is $links->[0]->id, $o1->id, 'direct retrieve 4 (direction from)';
139 # what happens if we delete a linked record?
142 $links = $i->linked_records(direction => 'from', from => 'Order');
143 is @$links, 0, 'no dangling link after delete';
145 # can we distinguish between types?
146 $o1 = new_order(quotation => 1);
148 $o1->link_to_record($o2);
150 $links = $o2->linked_records(direction => 'from', from => 'Order', query => [ quotation => 1 ]);
151 is $links->[0]->id, $o1->id, 'query restricted retrieve 1';
153 $links = $o2->linked_records(direction => 'from', from => 'Order', query => [ quotation => 0 ]);
154 is @$links, 0, 'query restricted retrieve 2';
156 # try bidirectional linking
159 $o1->link_to_record($o2, bidirectional => 1);
161 $links = $o1->linked_records(direction => 'to', to => 'Order');
162 is $links->[0]->id, $o2->id, 'bidi 1';
163 $links = $o1->linked_records(direction => 'from', from => 'Order');
164 is $links->[0]->id, $o2->id, 'bidi 2';
165 $links = $o1->linked_records(direction => 'both', both => 'Order');
166 is $links->[0]->id, $o2->id, 'bidi 3';
168 # funky stuff with both
170 $d = new_delivery_order();
173 $o2->link_to_record($d);
174 $d->link_to_record($i);
175 # at this point the structure is:
177 # o1 <--> o2 ---> d ---> i
180 $links = $d->linked_records(direction => 'both', to => 'Invoice', from => 'Order', sort_by => 'customer_id', sort_dir => 1);
181 is $links->[0]->id, $o2->id, 'both with different from/to 1';
182 is $links->[1]->id, $i->id, 'both with different from/to 2';
184 # what happens if we double link?
186 $o2->link_to_record($d);
188 $links = $o2->linked_records(direction => 'to', to => 'DeliveryOrder');
189 is @$links, 1, 'double link is only added once 1';
191 $d->link_to_record($o2, bidirectional => 1);
192 # at this point the structure is:
194 # o1 <--> o2 <--> d ---> i
197 $links = $o2->linked_records(direction => 'to', to => 'DeliveryOrder');
198 is @$links, 1, 'double link is only added once 2';
200 # doc states that to/from ae optional. test that
201 $links = $o2->linked_records(direction => 'both');
202 is @$links, 2, 'links without from/to get all';
204 # doc states you can limit with direction when giving excess params
205 $links = $d->linked_records(direction => 'to', to => 'Invoice', from => 'Order');
206 is $links->[0]->id, $i->id, 'direction to limit params 1';
207 is @$links, 1, 'direction to limit params 2';
209 # doc says there will be special values set... lets see
210 $links = $o1->linked_records(direction => 'to', to => 'Order');
211 is $links->[0]->{_record_link_direction}, 'to', '_record_link_direction to';
212 is $links->[0]->{_record_link}->to_id, $o2->id, '_record_link to';
214 $links = $o1->linked_records(direction => 'from', from => 'Order');
215 is $links->[0]->{_record_link_direction}, 'from', '_record_link_direction from';
216 is $links->[0]->{_record_link}->to_id, $o1->id, '_record_link from';
218 # check if bidi returns an array of links even if aready existing
219 my @links = $d->link_to_record($o2, bidirectional => 1);
220 # at this point the structure is:
222 # o1 <--> o2 <--> d ---> i
224 is @links, 2, 'bidi returns array of links in array context';
227 $links = $o2->linked_records(direction => 'to', to => 'Invoice', via => 'DeliveryOrder');
228 is $links->[0]->id, $i->id, 'simple case via links (string)';
230 $links = $o2->linked_records(direction => 'to', to => 'Invoice', via => [ 'DeliveryOrder' ]);
231 is $links->[0]->id, $i->id, 'simple case via links (arrayref)';
233 $links = $o1->linked_records(direction => 'to', to => 'Invoice', via => [ 'Order', 'DeliveryOrder' ]);
234 is $links->[0]->id, $i->id, 'simple case via links (2 hops)';
236 # multiple links in the same direction from one object
237 $o1->link_to_record($d);
238 # at this point the structure is:
240 # o1 <--> o2 <--> d ---> i
244 $links = $o2->linked_records(direction => 'to', to => 'Invoice', via => 'DeliveryOrder');
245 is $links->[0]->id, $i->id, 'simple case via links (string)';
248 # o1 must have 2 linked records now:
249 $links = $o1->linked_records(direction => 'to');
250 is @$links, 2, 'more than one link';
252 # as a special funny case, o1 via Order, Order will now yield o2, because it bounces back over itself
253 { local $TODO = 'no idea if this is desired';
254 $links = $o2->linked_records(direction => 'to', to => 'Order', via => [ 'Order', 'Order' ]);
255 is @$links, 2, 'via links with bidirectional hop over starting object';
258 # for sorting, get all don't bother with the links, we'll just take our records
259 my @records = ($o2, $i, $o1, $d);
261 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('type', 1, @records);
262 is_deeply $sorted, [$o1, $o2, $d, $i], 'sorting by type';
263 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('type', 0, @records);
264 is_deeply $sorted, [$i, $d, $o2, $o1], 'sorting by type desc';
271 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('number', 1, @records);
272 is_deeply $sorted, [$d, $o1, $i, $o2], 'sorting by number';
273 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('number', 0, @records);
274 is_deeply $sorted, [$o2, $i, $o1, $d], 'sorting by number desc';
276 # again with natural sorting
278 $o1->ordnumber("a3");
280 $o2->ordnumber("a10");
282 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('number', 1, @records);
283 is_deeply $sorted, [$d, $o1, $i, $o2], 'sorting naturally by number';
284 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('number', 0, @records);
285 is_deeply $sorted, [$o2, $i, $o1, $d], 'sorting naturally by number desc';
287 $o2->transdate(DateTime->new(year => 2010, month => 3, day => 1));
288 $i->transdate(DateTime->new(year => 2014, month => 3, day => 19));
289 $o1->transdate(DateTime->new(year => 2014, month => 5, day => 1));
290 $d->transdate(DateTime->new(year => 2014, month => 5, day => 2));
292 # transdate should be used before itime
293 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('date', 1, @records);
294 is_deeply $sorted, [$o2, $i, $o1, $d], 'sorting by transdate';
295 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('date', 0, @records);
296 is_deeply $sorted, [$d, $o1, $i, $o2], 'sorting by transdate desc';
298 # now recursive stuff 2, with backlinks
299 $links = $o1->linked_records(direction => 'to', recursive => 1, save_path => 1);
300 is @$links, 4, 'recursive finds all 4 (backlink to self because of bidi o1<->o2)';
302 # because of the link o1->d the longest path should be legth 2. test that
303 is max(map { $_->{_record_link_depth} } @$links), 2, 'longest path is 2';
305 $links = $o2->linked_records(direction => 'to', recursive => 1);
306 is @$links, 4, 'recursive from o2 finds 4';
308 $links = $o1->linked_records(direction => 'from', recursive => 1, save_path => 1);
309 is @$links, 3, 'recursive from o1 finds 3 (not i)';
311 $links = $i->linked_records(direction => 'from', recursive => 1, save_path => 1);
312 is @$links, 3, 'recursive from i finds 3 (not i)';
314 $links = $o1->linked_records(direction => 'both', recursive => 1, save_path => 1);
315 is @$links, 4, 'recursive dir=both does not give duplicates';