t/db_helper/record_links.t

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