SL/DB/Helper/PriceTaxCalculator.pm

   1 package SL::DB::Helper::PriceTaxCalculator;
   2
   3 use strict;
   4
   5 use parent qw(Exporter);
   6 our @EXPORT = qw(calculate_prices_and_taxes);
   7
   8 use Carp;
   9 use List::Util qw(sum min max);
  10
  11 sub calculate_prices_and_taxes {
  12   my ($self, %params) = @_;
  13
  14   require SL::DB::Chart;
  15   require SL::DB::Currency;
  16   require SL::DB::Default;
  17   require SL::DB::InvoiceItem;
  18   require SL::DB::Part;
  19   require SL::DB::PriceFactor;
  20   require SL::DB::Unit;
  21
  22   SL::DB::Part->load_cached(map { $_->parts_id } @{ $self->items }) if @{ $self->items };
  23
  24   my %units_by_name       = map { ( $_->name => $_ ) } @{ SL::DB::Manager::Unit->get_all        };
  25   my %price_factors_by_id = map { ( $_->id   => $_ ) } @{ SL::DB::Manager::PriceFactor->get_all };
  26
  27   my %data = ( lastcost_total      => 0,
  28                invoicediff         => 0,
  29                last_incex_chart_id => undef,
  30                units_by_name       => \%units_by_name,
  31                price_factors_by_id => \%price_factors_by_id,
  32                taxes               => { },
  33                amounts             => { },
  34                amounts_cogs        => { },
  35                allocated           => { },
  36                assembly_items      => [ ],
  37                exchangerate        => undef,
  38                is_sales            => $self->can('customer') && $self->customer,
  39                is_invoice          => (ref($self) =~ /Invoice/) || $params{invoice},
  40                items               => { },
  41              );
  42
  43   _get_exchangerate($self, \%data, %params);
  44
  45   $self->netamount(  0);
  46   $self->marge_total(0);
  47
  48   SL::DB::Manager::Chart->cache_taxkeys(date => $self->transdate);
  49
  50   my $idx = 0;
  51   foreach my $item ($self->items) {
  52     $idx++;
  53     _calculate_item($self, $item, $idx, \%data, %params);
  54   }
  55
  56   _calculate_amounts($self, \%data, %params);
  57
  58   return $self unless wantarray;
  59
  60   return map { ($_ => $data{$_}) } qw(taxes amounts amounts_cogs allocated exchangerate assembly_items items);
  61 }
  62
  63 sub _get_exchangerate {
  64   my ($self, $data, %params) = @_;
  65
  66   my $currency = $self->currency_id ? SL::DB::Currency->load_cached($self->currency_id)->name || '' : '';
  67   if ($currency ne SL::DB::Default->get_default_currency) {
  68     $data->{exchangerate}   = $::form->check_exchangerate(\%::myconfig, $currency, $self->transdate, $data->{is_sales} ? 'buy' : 'sell');
  69     $data->{exchangerate} ||= $params{exchangerate};
  70   }
  71   $data->{exchangerate} ||= 1;
  72 }
  73
  74 sub _calculate_item {
  75   my ($self, $item, $idx, $data, %params) = @_;
  76
  77   my $part       = SL::DB::Part->load_cached($item->parts_id);
  78   my $part_unit  = $data->{units_by_name}->{ $part->unit };
  79   my $item_unit  = $data->{units_by_name}->{ $item->unit };
  80
  81   croak("Undefined unit " . $part->unit) if !$part_unit;
  82   croak("Undefined unit " . $item->unit)       if !$item_unit;
  83
  84   $item->base_qty($item_unit->convert_to($item->qty, $part_unit));
  85   $item->fxsellprice($item->sellprice) if $data->{is_invoice};
  86
  87   my $num_dec   = max 2, _num_decimal_places($item->sellprice);
  88   my $discount  = _round($item->sellprice * ($item->discount || 0), $num_dec);
  89   my $sellprice = _round($item->sellprice - $discount,              $num_dec);
  90
  91   $item->price_factor(      ! $item->price_factor_obj   ? 1 : ($item->price_factor_obj->factor   || 1));
  92   $item->marge_price_factor(! $part->price_factor ? 1 : ($part->price_factor->factor || 1));
  93   my $linetotal = _round($sellprice * $item->qty / $item->price_factor, 2) * $data->{exchangerate};
  94   $linetotal    = _round($linetotal,                                    2);
  95
  96   $data->{invoicediff} += $sellprice * $item->qty * $data->{exchangerate} / $item->price_factor - $linetotal if $self->taxincluded;
  97
  98   my $linetotal_cost = 0;
  99
 100   if (!$linetotal) {
 101     $item->marge_total(  0);
 102     $item->marge_percent(0);
 103
 104   } else {
 105     my $lastcost       = ! ($item->lastcost * 1) ? ($part->lastcost || 0) : $item->lastcost;
 106     $linetotal_cost    = _round($lastcost * $item->qty / $item->marge_price_factor, 2);
 107
 108     $item->marge_total(  $linetotal - $linetotal_cost);
 109     $item->marge_percent($item->marge_total * 100 / $linetotal);
 110
 111     $self->marge_total(  $self->marge_total + $item->marge_total);
 112     $data->{lastcost_total} += $linetotal_cost;
 113   }
 114
 115   my $taxkey     = $part->get_taxkey(date => $self->transdate, is_sales => $data->{is_sales}, taxzone => $self->taxzone_id);
 116   my $tax_rate   = $taxkey->tax->rate;
 117   my $tax_amount = undef;
 118
 119   if ($self->taxincluded) {
 120     $tax_amount = $linetotal * $tax_rate / ($tax_rate + 1);
 121     $sellprice  = $sellprice             / ($tax_rate + 1);
 122
 123   } else {
 124     $tax_amount = $linetotal * $tax_rate;
 125   }
 126
 127   if ($taxkey->tax->chart_id) {
 128     $data->{taxes}->{ $taxkey->tax->chart_id } ||= 0;
 129     $data->{taxes}->{ $taxkey->tax->chart_id }  += $tax_amount;
 130   } elsif ($tax_amount) {
 131     die "tax_amount != 0 but no chart_id for taxkey " . $taxkey->id . " tax " . $taxkey->tax->id;
 132   }
 133
 134   $self->netamount($self->netamount + $sellprice * $item->qty / $item->price_factor);
 135
 136   my $chart = $part->get_chart(type => $data->{is_sales} ? 'income' : 'expense', taxzone => $self->taxzone_id);
 137   $data->{amounts}->{ $chart->id }           ||= { taxkey => $taxkey->taxkey_id, tax_id => $taxkey->tax_id, amount => 0 };
 138   $data->{amounts}->{ $chart->id }->{amount}  += $linetotal;
 139   $data->{amounts}->{ $chart->id }->{amount}  -= $tax_amount if $self->taxincluded;
 140
 141   push @{ $data->{assembly_items} }, [];
 142   if ($part->is_assembly) {
 143     _calculate_assembly_item($self, $data, $part, $item->base_qty, $item_unit->convert_to(1, $part_unit));
 144   } elsif ($part->is_part) {
 145     if ($data->{is_invoice}) {
 146       $item->allocated(_calculate_part_item($self, $data, $part, $item->base_qty, $item_unit->convert_to(1, $part_unit)));
 147     }
 148   }
 149
 150   $data->{last_incex_chart_id} = $chart->id if $data->{is_sales};
 151
 152   $data->{items}->{ $item->id } = {
 153     linetotal      => $linetotal,
 154     linetotal_cost => $linetotal_cost,
 155     sellprice      => $sellprice,
 156     tax_amount     => $tax_amount,
 157     taxkey         => $taxkey,
 158   };
 159
 160   _dbg("CALCULATE! ${idx} i.qty " . $item->qty . " i.sellprice " . $item->sellprice . " sellprice $sellprice num_dec $num_dec taxamount $tax_amount " .
 161        "i.linetotal $linetotal netamount " . $self->netamount . " marge_total " . $item->marge_total . " marge_percent " . $item->marge_percent);
 162 }
 163
 164 sub _calculate_amounts {
 165   my ($self, $data, %params) = @_;
 166
 167   my $tax_diff = 0;
 168   foreach my $chart_id (keys %{ $data->{taxes} }) {
 169     my $rounded                  = _round($data->{taxes}->{$chart_id} * $data->{exchangerate}, 2);
 170     $tax_diff                   += $data->{taxes}->{$chart_id} * $data->{exchangerate} - $rounded if $self->taxincluded;
 171     $data->{taxes}->{$chart_id}  = $rounded;
 172   }
 173
 174   my $amount    = _round(($self->netamount + $tax_diff) * $data->{exchangerate}, 2);
 175   my $diff      = $amount - ($self->netamount + $tax_diff) * $data->{exchangerate};
 176   my $netamount = $amount;
 177
 178   if ($self->taxincluded) {
 179     $data->{invoicediff}                                         += $diff;
 180     $data->{amounts}->{ $data->{last_incex_chart_id} }->{amount} += $data->{invoicediff} if $data->{last_incex_chart_id};
 181   }
 182
 183   _dbg("Sna " . $self->netamount . " idiff " . $data->{invoicediff} . " tdiff ${tax_diff}");
 184
 185   my $tax              = sum values %{ $data->{taxes} };
 186   $data->{arap_amount} = $netamount + $tax;
 187
 188   $self->netamount(    $netamount);
 189   $self->amount(       $netamount + $tax);
 190   $self->marge_percent($self->netamount ? ($self->netamount - $data->{lastcost_total}) * 100 / $self->netamount : 0);
 191 }
 192
 193 sub _calculate_assembly_item {
 194   my ($self, $data, $part, $total_qty, $base_factor) = @_;
 195
 196   return 0 if $::instance_conf->get_inventory_system eq 'periodic' || !$data->{is_invoice};
 197
 198   foreach my $assembly_entry (@{ $part->assemblies }) {
 199     push @{ $data->{assembly_items}->[-1] }, { part      => $assembly_entry->part,
 200                                                qty       => $total_qty * $assembly_entry->qty,
 201                                                allocated => 0 };
 202
 203     if ($assembly_entry->part->is_assembly) {
 204       _calculate_assembly_item($self, $data, $assembly_entry->part, $total_qty * $assembly_entry->qty);
 205     } elsif ($assembly_entry->part->is_part) {
 206       my $allocated = _calculate_part_item($self, $data, $assembly_entry->part, $total_qty * $assembly_entry->qty);
 207       $data->{assembly_items}->[-1]->[-1]->{allocated} = $allocated;
 208     }
 209   }
 210 }
 211
 212 sub _calculate_part_item {
 213   my ($self, $data, $part, $total_qty, $base_factor) = @_;
 214
 215   _dbg("cpsi tq " . $total_qty);
 216
 217   return 0 if $::instance_conf->get_inventory_system eq 'periodic' || !$data->{is_invoice} || !$total_qty;
 218
 219   my ($entry);
 220   $base_factor           ||= 1;
 221   my $remaining_qty        = $total_qty;
 222   my $expense_income_chart = $part->get_chart(type => $data->{is_sales} ? 'expense' : 'income', taxzone => $self->taxzone_id);
 223   my $inventory_chart      = $part->get_chart(type => 'inventory',                              taxzone => $self->taxzone_id);
 224
 225   my $iterator             = SL::DB::Manager::InvoiceItem->get_all_iterator(query => [ and => [ parts_id => $part->id,
 226                                                                                                 \'(base_qty + allocated) < 0' ] ]);
 227
 228   while (($remaining_qty > 0) && ($entry = $iterator->next)) {
 229     my $qty = min($remaining_qty, $entry->base_qty * -1 - $entry->allocated - $data->{allocated}->{ $entry->id });
 230     _dbg("qty $qty");
 231
 232     next unless $qty;
 233
 234     my $linetotal = _round(($entry->sellprice * $qty) / $base_factor, 2);
 235
 236     $data->{amounts_cogs}->{ $expense_income_chart->id } -= $linetotal;
 237     $data->{amounts_cogs}->{ $inventory_chart->id      } += $linetotal;
 238
 239     $data->{allocated}->{ $entry->id } ||= 0;
 240     $data->{allocated}->{ $entry->id }  += $qty;
 241     $remaining_qty                      -= $qty;
 242   }
 243
 244   $iterator->finish;
 245
 246   return $remaining_qty - $total_qty;
 247 }
 248
 249 sub _round {
 250   return $::form->round_amount(@_);
 251 }
 252
 253 sub _num_decimal_places {
 254   return length( (split(/\./, '' . ($_[0] * 1), 2))[1] || '' );
 255 }
 256
 257 sub _dbg {
 258   # $::lxdebug->message(0, join(' ', @_));
 259 }
 260
 261 1;
 262 __END__
 263
 264 =pod
 265
 266 =encoding utf8
 267
 268 =head1 NAME
 269
 270 SL::DB::Helper::PriceTaxCalculator - Mixin for calculating the prices,
 271 amounts and taxes of orders, quotations, invoices
 272
 273 =head1 FUNCTIONS
 274
 275 =over 4
 276
 277 =item C<calculate_prices_and_taxes %params>
 278
 279 Calculates the prices, amounts and taxes for an order, a quotation or
 280 an invoice.
 281
 282 The function assumes that the mixing package has a certain layout and
 283 provides certain functions:
 284
 285 =over 2
 286
 287 =item C<transdate>
 288
 289 The record's date.
 290
 291 =item C<customer> or C<vendor>
 292
 293 Determines if the record is a sales or purchase record.
 294
 295 =item C<items>
 296
 297 Accessor returning all line items for this record. The line items
 298 themselves must again have a certain layout. Instances of
 299 L<SL::DB::OrderItem> and L<SL::DB::InvoiceItem> are supported.
 300
 301 =back
 302
 303 The following values are calculated and set for C<$self>: C<amount>,
 304 C<netamount>, C<marge_percent>, C<marge_total>.
 305
 306 The following values are calculated and set for each line item:
 307 C<base_qty>, C<price_factor>, C<marge_price_factor>, C<marge_total>,
 308 C<marge_percent>.
 309
 310 The objects are not saved.
 311
 312 Returns C<$self> in scalar context.
 313
 314 In array context a hash with the following keys is returned:
 315
 316 =over 2
 317
 318 =item C<taxes>
 319
 320 A hash reference with the calculated taxes. The keys are chart IDs,
 321 the values the calculated taxes.
 322
 323 =item C<amounts>
 324
 325 A hash reference with the calculated amounts. The keys are chart IDs,
 326 the values are hash references containing the two keys C<amount> and
 327 C<taxkey>.
 328
 329 =item C<amounts_cogs>
 330
 331 A hash reference with the calculated amounts for costs of goods
 332 sold. The keys are chart IDs, the values the calculated amounts.
 333
 334 =item C<assembly_items>
 335
 336 An array reference with as many entries as there are items in the
 337 record. Each entry is again an array reference of hash references with
 338 the keys C<part> (an instance of L<SL::DB::Part>), C<qty> and
 339 C<allocated>. Is only valid for invoices and can be used to populate
 340 the C<invoice> table with entries for assemblies.
 341
 342 =item C<allocated>
 343
 344 A hash reference. The keys are IDs of entries in the C<invoice>
 345 table. The values are the new values for the entry's C<allocated>
 346 column. Only valid for invoices.
 347
 348 =item C<exchangerate>
 349
 350 The exchangerate used for the calculation.
 351
 352 =item C<items>
 353
 354 A hashref. For each line item this hashref contains an entry with
 355 additional values that have been calculated for that item but that
 356 aren't stored in the item object itself. These include C<linetotal>,
 357 C<linetotal_cost>, C<sellprice>, C<tax_amount> and C<taxkey>.
 358
 359 The items are hashed by their IDs.
 360
 361 =back
 362
 363 =back
 364
 365 =head1 BUGS
 366
 367 Nothing here yet.
 368
 369 =head1 AUTHOR
 370
 371 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 372
 373 =cut