t/db_helper/record_links.t

   1 use Test::More tests => 49;
   2
   3 use strict;
   4
   5 use lib 't';
   6 use utf8;
   7
   8 use Carp;
   9 use Data::Dumper;
  10 use Support::TestSetup;
  11 use Test::Exception;
  12 use List::Util qw(max);
  13
  14 use SL::DB::Buchungsgruppe;
  15 use SL::DB::Currency;
  16 use SL::DB::Customer;
  17 use SL::DB::Employee;
  18 use SL::DB::Invoice;
  19 use SL::DB::Order;
  20 use SL::DB::DeliveryOrder;
  21 use SL::DB::Part;
  22 use SL::DB::Unit;
  23 use SL::DB::TaxZone;
  24
  25 my ($customer, $currency_id, $buchungsgruppe, $employee, $vendor, $taxzone);
  26 my ($link, $links, $o1, $o2, $d, $i);
  27
  28 sub clear_up {
  29   SL::DB::Manager::DeliveryOrder->delete_all(all => 1);
  30   SL::DB::Manager::Order->delete_all(all => 1);
  31   SL::DB::Manager::Invoice->delete_all(all => 1);
  32   SL::DB::Manager::Part->delete_all(all => 1);
  33   SL::DB::Manager::Customer->delete_all(all => 1);
  34   SL::DB::Manager::Vendor->delete_all(all => 1);
  35 };
  36
  37 sub reset_state {
  38   my %params = @_;
  39
  40   $params{$_} ||= {} for qw(buchungsgruppe unit customer part tax);
  41
  42   clear_up();
  43
  44   if ($::lx_office_conf{system}->{default_manager} eq "swiss") {
  45     $buchungsgruppe  = SL::DB::Manager::Buchungsgruppe->find_by(description => 'Standard 8%', %{ $params{buchungsgruppe} })  || croak "No accounting group";
  46     $employee        = SL::DB::Manager::Employee->current                                                                    || croak "No employee";
  47     $taxzone         = SL::DB::Manager::TaxZone->find_by( description => 'Schweiz')                                          || croak "No taxzone";
  48   } else {
  49     $buchungsgruppe  = SL::DB::Manager::Buchungsgruppe->find_by(description => 'Standard 19%', %{ $params{buchungsgruppe} }) || croak "No accounting group";
  50     $employee        = SL::DB::Manager::Employee->current                                                                    || croak "No employee";
  51     $taxzone         = SL::DB::Manager::TaxZone->find_by( description => 'Inland')                                           || croak "No taxzone";
  52   }
  53
  54   $currency_id     = $::instance_conf->get_currency_id;
  55
  56   $customer     = SL::DB::Customer->new(
  57     name        => 'Test Customer',
  58     currency_id => $currency_id,
  59     taxzone_id  => $taxzone->id,
  60     %{ $params{customer} }
  61   )->save;
  62
  63   $vendor     = SL::DB::Vendor->new(
  64     name        => 'Test Vendor',
  65     currency_id => $currency_id,
  66     taxzone_id  => $taxzone->id,
  67     %{ $params{vendor} }
  68   )->save;
  69 }
  70
  71 sub new_order {
  72   my %params  = @_;
  73
  74   return SL::DB::Order->new(
  75     customer_id => $customer->id,
  76     currency_id => $currency_id,
  77     employee_id => $employee->id,
  78     salesman_id => $employee->id,
  79     taxzone_id  => $taxzone->id,
  80     quotation   => 0,
  81     %params,
  82   )->save;
  83 }
  84
  85 sub new_delivery_order {
  86   my %params  = @_;
  87
  88   return SL::DB::DeliveryOrder->new(
  89     customer_id => $customer->id,
  90     currency_id => $currency_id,
  91     employee_id => $employee->id,
  92     salesman_id => $employee->id,
  93     taxzone_id  => $taxzone->id,
  94     %params,
  95   )->save;
  96 }
  97
  98 sub new_invoice {
  99   my %params  = @_;
 100
 101   return SL::DB::Invoice->new(
 102     customer_id => $customer->id,
 103     currency_id => $currency_id,
 104     employee_id => $employee->id,
 105     salesman_id => $employee->id,
 106     gldate      => DateTime->today_local->to_kivitendo,
 107     invoice     => 1,
 108     taxzone_id  => $taxzone->id,
 109     type        => 'invoice',
 110     %params,
 111   )->save;
 112 }
 113
 114 Support::TestSetup::login();
 115
 116 reset_state();
 117
 118 $o1 = new_order();
 119 $i  = new_invoice();
 120
 121 $link = $o1->link_to_record($i);
 122
 123 # try to add a link
 124 is ref $link, 'SL::DB::RecordLink', 'link_to_record returns new link';
 125 is $link->from_table, 'oe', 'from_table';
 126 is $link->from_id, $o1->id, 'from_id';
 127 is $link->to_table, 'ar', 'to_table';
 128 is $link->to_id, $i->id, 'to_id';
 129
 130 # retrieve link
 131 $links = $o1->linked_records;
 132 is $links->[0]->id, $i->id, 'simple retrieve';
 133
 134 $links = $o1->linked_records(direction => 'to', to => 'Invoice');
 135 is $links->[0]->id, $i->id, 'direct retrieve 1';
 136
 137 $links = $o1->linked_records(direction => 'to', to => 'SL::DB::Invoice');
 138 is $links->[0]->id, $i->id, 'direct retrieve 2 (with SL::DB::)';
 139
 140 $links = $o1->linked_records(direction => 'to', to => [ 'Invoice', 'Order' ]);
 141 is $links->[0]->id, $i->id, 'direct retrieve 3 (array target)';
 142
 143 $links = $o1->linked_records(direction => 'both', both => 'Invoice');
 144 is $links->[0]->id, $i->id, 'direct retrieve 4 (direction both)';
 145
 146 $links = $i->linked_records(direction => 'from', from => 'Order');
 147 is $links->[0]->id, $o1->id, 'direct retrieve 4 (direction from)';
 148
 149 # what happens if we delete a linked record?
 150 $o1->delete;
 151
 152 $links = $i->linked_records(direction => 'from', from => 'Order');
 153 is @$links, 0, 'no dangling link after delete';
 154
 155 # can we distinguish between types?
 156 $o1 = new_order(quotation => 1);
 157 $o2 = new_order();
 158 $o1->link_to_record($o2);
 159
 160 $links = $o2->linked_records(direction => 'from', from => 'Order', query => [ quotation => 1 ]);
 161 is $links->[0]->id, $o1->id, 'query restricted retrieve 1';
 162
 163 $links = $o2->linked_records(direction => 'from', from => 'Order', query => [ quotation => 0 ]);
 164 is @$links, 0, 'query restricted retrieve 2';
 165
 166 # try bidirectional linking
 167 $o1 = new_order();
 168 $o2 = new_order();
 169 $o1->link_to_record($o2, bidirectional => 1);
 170
 171 $links = $o1->linked_records(direction => 'to', to => 'Order');
 172 is $links->[0]->id, $o2->id, 'bidi 1';
 173 $links = $o1->linked_records(direction => 'from', from => 'Order');
 174 is $links->[0]->id, $o2->id, 'bidi 2';
 175 $links = $o1->linked_records(direction => 'both', both => 'Order');
 176 is $links->[0]->id, $o2->id, 'bidi 3';
 177
 178 # funky stuff with both
 179 #
 180 $d = new_delivery_order();
 181 $i = new_invoice();
 182
 183 $o2->link_to_record($d);
 184 $d->link_to_record($i);
 185 # at this point the structure is:
 186 #
 187 #   o1 <--> o2 ---> d ---> i
 188 #
 189
 190 $links = $d->linked_records(direction => 'both', to => 'Invoice', from => 'Order', sort_by => 'customer_id', sort_dir => 1);
 191 is $links->[0]->id, $o2->id, 'both with different from/to 1';
 192 is $links->[1]->id, $i->id,  'both with different from/to 2';
 193
 194 # what happens if we double link?
 195 #
 196 $o2->link_to_record($d);
 197
 198 $links = $o2->linked_records(direction => 'to', to => 'DeliveryOrder');
 199 is @$links, 1, 'double link is only added once 1';
 200
 201 $d->link_to_record($o2, bidirectional => 1);
 202 # at this point the structure is:
 203 #
 204 #   o1 <--> o2 <--> d ---> i
 205 #
 206
 207 $links = $o2->linked_records(direction => 'to', to => 'DeliveryOrder');
 208 is @$links, 1, 'double link is only added once 2';
 209
 210 # doc states that to/from ae optional. test that
 211 $links = $o2->linked_records(direction => 'both');
 212 is @$links, 2, 'links without from/to get all';
 213
 214 # doc states you can limit with direction when giving excess params
 215 $links = $d->linked_records(direction => 'to', to => 'Invoice', from => 'Order');
 216 is $links->[0]->id, $i->id, 'direction to limit params  1';
 217 is @$links, 1, 'direction to limit params 2';
 218
 219 # doc says there will be special values set... lets see
 220 $links = $o1->linked_records(direction => 'to', to => 'Order');
 221 is $links->[0]->{_record_link_direction}, 'to',  '_record_link_direction to';
 222 is $links->[0]->{_record_link}->to_id, $o2->id,  '_record_link to';
 223
 224 $links = $o1->linked_records(direction => 'from', from => 'Order');
 225 is $links->[0]->{_record_link_direction}, 'from',  '_record_link_direction from';
 226 is $links->[0]->{_record_link}->to_id, $o1->id,  '_record_link from';
 227
 228 # check if bidi returns an array of links even if aready existing
 229 my @links = $d->link_to_record($o2, bidirectional => 1);
 230 # at this point the structure is:
 231 #
 232 #   o1 <--> o2 <--> d ---> i
 233 #
 234 is @links, 2, 'bidi returns array of links in array context';
 235
 236 #  via
 237 $links = $o2->linked_records(direction => 'to', to => 'Invoice', via => 'DeliveryOrder');
 238 is $links->[0]->id, $i->id,  'simple case via links (string)';
 239
 240 $links = $o2->linked_records(direction => 'to', to => 'Invoice', via => [ 'DeliveryOrder' ]);
 241 is $links->[0]->id, $i->id,  'simple case via links (arrayref)';
 242
 243 $links = $o1->linked_records(direction => 'to', to => 'Invoice', via => [ 'Order', 'DeliveryOrder' ]);
 244 is $links->[0]->id, $i->id,  'simple case via links (2 hops)';
 245
 246 # multiple links in the same direction from one object
 247 $o1->link_to_record($d);
 248 # at this point the structure is:
 249 #
 250 #   o1 <--> o2 <--> d ---> i
 251 #     \____________,^
 252 #
 253
 254 $links = $o2->linked_records(direction => 'to', to => 'Invoice', via => 'DeliveryOrder');
 255 is $links->[0]->id, $i->id,  'simple case via links (string)';
 256
 257
 258 # o1 must have 2 linked records now:
 259 $links = $o1->linked_records(direction => 'to');
 260 is @$links, 2,  'more than one link';
 261
 262 # as a special funny case, o1 via Order, Order will now yield o2, because it bounces back over itself
 263 { local $TODO = 'no idea if this is desired';
 264 $links = $o2->linked_records(direction => 'to', to => 'Order', via => [ 'Order', 'Order' ]);
 265 is @$links, 2,  'via links with bidirectional hop over starting object';
 266 }
 267
 268 # for sorting, get all don't bother with the links, we'll just take our records
 269 my @records = ($o2, $i, $o1, $d);
 270 my $sorted;
 271 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('type', 1, @records);
 272 is_deeply $sorted, [$o1, $o2, $d, $i], 'sorting by type';
 273 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('type', 0, @records);
 274 is_deeply $sorted, [$i, $d, $o2, $o1], 'sorting by type desc';
 275
 276 $d->donumber(1);
 277 $o1->ordnumber(2);
 278 $i->invnumber(3);
 279 $o2->ordnumber(4);
 280
 281 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('number', 1, @records);
 282 is_deeply $sorted, [$d, $o1, $i, $o2], 'sorting by number';
 283 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('number', 0, @records);
 284 is_deeply $sorted, [$o2, $i, $o1, $d], 'sorting by number desc';
 285
 286 # again with natural sorting
 287 $d->donumber("a1");
 288 $o1->ordnumber("a3");
 289 $i->invnumber("a7");
 290 $o2->ordnumber("a10");
 291
 292 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('number', 1, @records);
 293 is_deeply $sorted, [$d, $o1, $i, $o2], 'sorting naturally by number';
 294 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('number', 0, @records);
 295 is_deeply $sorted, [$o2, $i, $o1, $d], 'sorting naturally by number desc';
 296
 297 $o2->transdate(DateTime->new(year => 2010, month => 3, day => 1));
 298 $i->transdate(DateTime->new(year => 2014, month => 3, day => 19));
 299 $o1->transdate(DateTime->new(year => 2014, month => 5, day => 1));
 300 $d->transdate(DateTime->new(year => 2014, month => 5, day => 2));
 301
 302 # transdate should be used before itime
 303 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('date', 1, @records);
 304 is_deeply $sorted, [$o2, $i, $o1, $d], 'sorting by transdate';
 305 $sorted = SL::DB::Helper::LinkedRecords->sort_linked_records('date', 0, @records);
 306 is_deeply $sorted, [$d, $o1, $i, $o2], 'sorting by transdate desc';
 307
 308 # now recursive stuff 2, with backlinks
 309 $links = $o1->linked_records(direction => 'to', recursive => 1, save_path => 1);
 310 is @$links, 4, 'recursive finds all 4 (backlink to self because of bidi o1<->o2)';
 311
 312 # because of the link o1->d the longest path should be legth 2. test that
 313 is max(map { $_->{_record_link_depth} } @$links), 2, 'longest path is 2';
 314
 315 $links = $o2->linked_records(direction => 'to', recursive => 1);
 316 is @$links, 4, 'recursive from o2 finds 4';
 317
 318 $links = $o1->linked_records(direction => 'from', recursive => 1, save_path => 1);
 319 is @$links, 3, 'recursive from o1 finds 3 (not i)';
 320
 321 $links = $i->linked_records(direction => 'from', recursive => 1, save_path => 1);
 322 is @$links, 3, 'recursive from i finds 3 (not i)';
 323
 324 $links = $o1->linked_records(direction => 'both', recursive => 1, save_path => 1);
 325 is @$links, 4, 'recursive dir=both does not give duplicates';
 326
 327 clear_up();
 328
 329 1;