t/db_helper/record_links.t

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