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