-use Test::More tests => 43;
+use Test::More tests => 66;
use strict;
use Data::Dumper;
use Support::TestSetup;
use Test::Exception;
+use Test::Deep qw(cmp_bag);
+use List::Util qw(max);
use SL::DB::Buchungsgruppe;
use SL::DB::Currency;
use SL::DB::Invoice;
use SL::DB::Order;
use SL::DB::DeliveryOrder;
+use SL::DB::DeliveryOrder::TypeData qw(:types);
use SL::DB::Part;
use SL::DB::Unit;
+use SL::DB::TaxZone;
-my ($customer, $currency_id, $buchungsgruppe, $employee, $vendor);
+my ($customer, $currency_id, $buchungsgruppe, $employee, $vendor, $taxzone);
my ($link, $links, $o1, $o2, $d, $i);
-sub reset_state {
- my %params = @_;
-
- $params{$_} ||= {} for qw(buchungsgruppe unit customer part tax);
-
+sub clear_up {
SL::DB::Manager::DeliveryOrder->delete_all(all => 1);
SL::DB::Manager::Order->delete_all(all => 1);
SL::DB::Manager::Invoice->delete_all(all => 1);
+ SL::DB::Manager::Part->delete_all(all => 1);
SL::DB::Manager::Customer->delete_all(all => 1);
SL::DB::Manager::Vendor->delete_all(all => 1);
+};
+
+sub reset_state {
+ my %params = @_;
+
+ $params{$_} ||= {} for qw(buchungsgruppe unit customer part tax);
+
+ clear_up();
$buchungsgruppe = SL::DB::Manager::Buchungsgruppe->find_by(description => 'Standard 19%', %{ $params{buchungsgruppe} }) || croak "No accounting group";
$employee = SL::DB::Manager::Employee->current || croak "No employee";
+ $taxzone = SL::DB::Manager::TaxZone->find_by( description => 'Inland') || croak "No taxzone";
$currency_id = $::instance_conf->get_currency_id;
$customer = SL::DB::Customer->new(
name => 'Test Customer',
currency_id => $currency_id,
+ taxzone_id => $taxzone->id,
%{ $params{customer} }
)->save;
$vendor = SL::DB::Vendor->new(
name => 'Test Vendor',
currency_id => $currency_id,
+ taxzone_id => $taxzone->id,
%{ $params{vendor} }
)->save;
}
currency_id => $currency_id,
employee_id => $employee->id,
salesman_id => $employee->id,
- taxzone_id => 0,
+ taxzone_id => $taxzone->id,
quotation => 0,
%params,
)->save;
currency_id => $currency_id,
employee_id => $employee->id,
salesman_id => $employee->id,
- taxzone_id => 0,
+ taxzone_id => $taxzone->id,
+ order_type => SALES_DELIVERY_ORDER_TYPE,
%params,
)->save;
}
employee_id => $employee->id,
salesman_id => $employee->id,
gldate => DateTime->today_local->to_kivitendo,
- taxzone_id => 0,
invoice => 1,
+ taxzone_id => $taxzone->id,
type => 'invoice',
%params,
)->save;
reset_state();
-
$o1 = new_order();
$i = new_invoice();
$o2->link_to_record($d);
$d->link_to_record($i);
-
+# at this point the structure is:
+#
+# o1 <--> o2 ---> d ---> i
+#
$links = $d->linked_records(direction => 'both', to => 'Invoice', from => 'Order', sort_by => 'customer_id', sort_dir => 1);
is $links->[0]->id, $o2->id, 'both with different from/to 1';
is @$links, 1, 'double link is only added once 1';
$d->link_to_record($o2, bidirectional => 1);
+# at this point the structure is:
+#
+# o1 <--> o2 <--> d ---> i
+#
$links = $o2->linked_records(direction => 'to', to => 'DeliveryOrder');
is @$links, 1, 'double link is only added once 2';
is $links->[0]->{_record_link_direction}, 'from', '_record_link_direction from';
is $links->[0]->{_record_link}->to_id, $o1->id, '_record_link from';
-# check if bidi returns an array of links
+# check if bidi returns an array of links even if aready existing
my @links = $d->link_to_record($o2, bidirectional => 1);
+# at this point the structure is:
+#
+# o1 <--> o2 <--> d ---> i
+#
is @links, 2, 'bidi returns array of links in array context';
# via
# multiple links in the same direction from one object
$o1->link_to_record($d);
-$links = $o2->linked_records(direction => 'to', to => 'Invoice', via => 'DeliveryOrder');
-is $links->[0]->id, $i->id, 'simple case via links (string)';
-
# at this point the structure is:
#
-# o1 <--> o2 ---> d ---> i
+# o1 <--> o2 <--> d ---> i
# \____________,^
#
+$links = $o2->linked_records(direction => 'to', to => 'Invoice', via => 'DeliveryOrder');
+is $links->[0]->id, $i->id, 'simple case via links (string)';
+
+
# o1 must have 2 linked records now:
$links = $o1->linked_records(direction => 'to');
is @$links, 2, 'more than one link';
$sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('date', 0, @records);
is_deeply $sorted, [$d, $o1, $i, $o2], 'sorting by transdate desc';
+# now recursive stuff 2, with backlinks
+$links = $o1->linked_records(direction => 'to', recursive => 1, save_path => 1);
+is @$links, 4, 'recursive finds all 4 (backlink to self because of bidi o1<->o2)';
+
+# because of the link o1->d the longest path should be legth 2. test that
+is max(map { $_->{_record_link_depth} } @$links), 2, 'longest path is 2';
+
+$links = $o2->linked_records(direction => 'to', recursive => 1);
+is @$links, 4, 'recursive from o2 finds 4';
+
+$links = $o1->linked_records(direction => 'from', recursive => 1, save_path => 1);
+is @$links, 3, 'recursive from o1 finds 3 (not i)';
+
+$links = $i->linked_records(direction => 'from', recursive => 1, save_path => 1);
+is @$links, 3, 'recursive from i finds 3 (not i)';
+
+$links = $o1->linked_records(direction => 'both', recursive => 1, save_path => 1);
+is @$links, 4, 'recursive dir=both does not give duplicates';
+
+
+# test batch mode
+#
+#
+#
+
+reset_state();
+
+$o1 = new_order();
+$o2 = new_order();
+my $i1 = new_invoice();
+my $i2 = new_invoice();
+
+$o1->link_to_record($i1);
+$o2->link_to_record($i2);
+
+$links = $o1->linked_records(direction => 'to', to => 'Invoice', batch => [ $o1->id, $o2->id ]);
+is_deeply [ map { $_->id } @$links ], [ $i1->id , $i2->id ], "batch works";
+
+$links = $o1->linked_records(direction => 'to', recursive => 1, batch => [ $o1->id, $o2->id ]);
+cmp_bag [ map { $_->id } @$links ], [ $i1->id , $i2->id ], "batch works recursive";
+
+$links = $o1->linked_records(direction => 'to', to => 'Invoice', batch => [ $o1->id, $o2->id ], by_id => 1);
+# $::lxdebug->dump(0, "links", $links);
+is @{ $links->{$o1->id} }, 1, "batch by_id 1";
+is @{ $links->{$o2->id} }, 1, "batch by_id 2";
+is keys %$links, 2, "batch by_id 3";
+is $links->{$o1->id}[0]->id, $i1->id, "batch by_id 4";
+is $links->{$o2->id}[0]->id, $i2->id, "batch by_id 5";
+
+$links = $o1->linked_records(direction => 'to', recursive => 1, batch => [ $o1->id, $o2->id ], by_id => 1);
+is @{ $links->{$o1->id} }, 1, "batch recursive by_id 1";
+is @{ $links->{$o2->id} }, 1, "batch recursive by_id 2";
+is keys %$links, 2, "batch recursive by_id 3";
+is $links->{$o1->id}[0]->id, $i1->id, "batch recursive by_id 4";
+is $links->{$o2->id}[0]->id, $i2->id, "batch recursive by_id 5";
+
+$links = $o1->linked_records(direction => 'both', recursive => 1, batch => [ $o1->id, $o2->id ], by_id => 1);
+is @{ $links->{$o1->id} }, 1, "batch recursive by_id direction both 1";
+is @{ $links->{$o2->id} }, 1, "batch recursive by_id direction both 2";
+is keys %$links, 2, "batch recursive by_id direction both 3";
+is $links->{$o1->id}[0]->id, $i1->id, "batch recursive by_id direction both 4";
+is $links->{$o2->id}[0]->id, $i2->id, "batch recursive by_id direction both 5";
+
+clear_up();
+
1;
projects / kivitendo-erp.git / blobdiff