SL/Dev/Record.pm

   1 package SL::Dev::Record;
   2
   3 use strict;
   4 use base qw(Exporter);
   5 our @EXPORT_OK = qw(create_invoice_item
   6                     create_sales_invoice
   7                     create_credit_note
   8                     create_order_item
   9                     create_sales_order
  10                     create_purchase_order
  11                     create_delivery_order_item
  12                     create_sales_delivery_order
  13                     create_purchase_delivery_order
  14                     create_project create_department
  15                     create_ap_transaction
  16                     create_ar_transaction
  17                     create_gl_transaction
  18                    );
  19 our %EXPORT_TAGS = (ALL => \@EXPORT_OK);
  20
  21 use SL::DB::Invoice;
  22 use SL::DB::InvoiceItem;
  23 use SL::DB::DeliveryOrder::TypeData qw(:types);
  24 use SL::DB::Employee;
  25 use SL::Dev::Part qw(new_part);
  26 use SL::Dev::CustomerVendor qw(new_vendor new_customer);
  27 use SL::DB::Project;
  28 use SL::DB::ProjectStatus;
  29 use SL::DB::ProjectType;
  30 use SL::Form;
  31 use DateTime;
  32 use List::Util qw(sum);
  33 use Data::Dumper;
  34 use SL::Locale::String qw(t8);
  35 use SL::DATEV;
  36
  37 my %record_type_to_item_type = ( sales_invoice        => 'SL::DB::InvoiceItem',
  38                                  credit_note          => 'SL::DB::InvoiceItem',
  39                                  sales_order          => 'SL::DB::OrderItem',
  40                                  purchase_order       => 'SL::DB::OrderItem',
  41                                  sales_delivery_order => 'SL::DB::DeliveryOrderItem',
  42                                );
  43
  44 sub create_sales_invoice {
  45   my (%params) = @_;
  46
  47   my $record_type = 'sales_invoice';
  48   my $invoiceitems = delete $params{invoiceitems} // _create_two_items($record_type);
  49   _check_items($invoiceitems, $record_type);
  50
  51   my $customer = delete $params{customer} // new_customer(name => 'Testcustomer')->save;
  52   die "illegal customer" unless defined $customer && ref($customer) eq 'SL::DB::Customer';
  53
  54   my $invoice = SL::DB::Invoice->new(
  55     invoice      => 1,
  56     type         => 'invoice',
  57     customer_id  => $customer->id,
  58     taxzone_id   => $customer->taxzone->id,
  59     invnumber    => delete $params{invnumber}   // undef,
  60     currency_id  => $params{currency_id} // $::instance_conf->get_currency_id,
  61     taxincluded  => $params{taxincluded} // 0,
  62     employee_id  => $params{employee_id} // SL::DB::Manager::Employee->current->id,
  63     salesman_id  => $params{employee_id} // SL::DB::Manager::Employee->current->id,
  64     transdate    => $params{transdate}   // DateTime->today_local->to_kivitendo,
  65     payment_id   => $params{payment_id}  // undef,
  66     gldate       => DateTime->today,
  67     invoiceitems => $invoiceitems,
  68   );
  69   $invoice->assign_attributes(%params) if %params;
  70
  71   $invoice->post;
  72   return $invoice;
  73 }
  74
  75 sub create_credit_note {
  76   my (%params) = @_;
  77
  78   my $record_type = 'credit_note';
  79   my $invoiceitems = delete $params{invoiceitems} // _create_two_items($record_type);
  80   _check_items($invoiceitems, $record_type);
  81
  82   my $customer = delete $params{customer} // new_customer(name => 'Testcustomer')->save;
  83   die "illegal customer" unless defined $customer && ref($customer) eq 'SL::DB::Customer';
  84
  85   # adjust qty for credit note items
  86   $_->qty( $_->qty * -1) foreach @{$invoiceitems};
  87
  88   my $invoice = SL::DB::Invoice->new(
  89     invoice      => 1,
  90     type         => 'credit_note',
  91     customer_id  => $customer->id,
  92     taxzone_id   => $customer->taxzone->id,
  93     invnumber    => delete $params{invnumber}   // undef,
  94     currency_id  => $params{currency_id} // $::instance_conf->get_currency_id,
  95     taxincluded  => $params{taxincluded} // 0,
  96     employee_id  => $params{employee_id} // SL::DB::Manager::Employee->current->id,
  97     salesman_id  => $params{employee_id} // SL::DB::Manager::Employee->current->id,
  98     transdate    => $params{transdate}   // DateTime->today_local->to_kivitendo,
  99     payment_id   => $params{payment_id}  // undef,
 100     gldate       => DateTime->today,
 101     invoiceitems => $invoiceitems,
 102   );
 103   $invoice->assign_attributes(%params) if %params;
 104
 105   $invoice->post;
 106   return $invoice;
 107 }
 108
 109 sub create_sales_delivery_order {
 110   my (%params) = @_;
 111
 112   my $record_type = 'sales_delivery_order';
 113   my $orderitems = delete $params{orderitems} // _create_two_items($record_type);
 114   _check_items($orderitems, $record_type);
 115
 116   my $customer = $params{customer} // new_customer(name => 'Testcustomer')->save;
 117   die "illegal customer" unless ref($customer) eq 'SL::DB::Customer';
 118
 119   my $delivery_order = SL::DB::DeliveryOrder->new(
 120     order_type   => SALES_DELIVERY_ORDER_TYPE,
 121     'closed'     => undef,
 122     customer_id  => $customer->id,
 123     taxzone_id   => $customer->taxzone_id,
 124     donumber     => $params{donumber}    // undef,
 125     currency_id  => $params{currency_id} // $::instance_conf->get_currency_id,
 126     taxincluded  => $params{taxincluded} // 0,
 127     employee_id  => $params{employee_id} // SL::DB::Manager::Employee->current->id,
 128     salesman_id  => $params{employee_id} // SL::DB::Manager::Employee->current->id,
 129     transdate    => $params{transdate}   // DateTime->today,
 130     orderitems   => $orderitems,
 131   );
 132   $delivery_order->assign_attributes(%params) if %params;
 133   $delivery_order->save;
 134   return $delivery_order;
 135 }
 136
 137 sub create_purchase_delivery_order {
 138   my (%params) = @_;
 139
 140   my $record_type = 'purchase_delivery_order';
 141   my $orderitems = delete $params{orderitems} // _create_two_items($record_type);
 142   _check_items($orderitems, $record_type);
 143
 144   my $vendor = $params{vendor} // new_vendor(name => 'Testvendor')->save;
 145   die "illegal customer" unless ref($vendor) eq 'SL::DB::Vendor';
 146
 147   my $delivery_order = SL::DB::DeliveryOrder->new(
 148     order_type   => PURCHASE_DELIVERY_ORDER_TYPE,
 149     'closed'     => undef,
 150     vendor_id    => $vendor->id,
 151     taxzone_id   => $vendor->taxzone_id,
 152     donumber     => $params{donumber}    // undef,
 153     currency_id  => $params{currency_id} // $::instance_conf->get_currency_id,
 154     taxincluded  => $params{taxincluded} // 0,
 155     employee_id  => $params{employee_id} // SL::DB::Manager::Employee->current->id,
 156     salesman_id  => $params{employee_id} // SL::DB::Manager::Employee->current->id,
 157     transdate    => $params{transdate}   // DateTime->today,
 158     orderitems   => $orderitems,
 159   );
 160   $delivery_order->assign_attributes(%params) if %params;
 161   $delivery_order->save;
 162   return $delivery_order;
 163 }
 164
 165 sub create_sales_order {
 166   my (%params) = @_;
 167
 168   my $record_type = 'sales_order';
 169   my $orderitems = delete $params{orderitems} // _create_two_items($record_type);
 170   _check_items($orderitems, $record_type);
 171
 172   my $save = delete $params{save} // 0;
 173
 174   my $customer = $params{customer} // new_customer(name => 'Testcustomer')->save;
 175   die "illegal customer" unless ref($customer) eq 'SL::DB::Customer';
 176
 177   my $order = SL::DB::Order->new(
 178     customer_id  => delete $params{customer_id} // $customer->id,
 179     taxzone_id   => delete $params{taxzone_id}  // $customer->taxzone->id,
 180     currency_id  => delete $params{currency_id} // $::instance_conf->get_currency_id,
 181     taxincluded  => delete $params{taxincluded} // 0,
 182     employee_id  => delete $params{employee_id} // SL::DB::Manager::Employee->current->id,
 183     salesman_id  => delete $params{employee_id} // SL::DB::Manager::Employee->current->id,
 184     transdate    => delete $params{transdate}   // DateTime->today,
 185     orderitems   => $orderitems,
 186   );
 187   $order->assign_attributes(%params) if %params;
 188
 189   if ( $save ) {
 190     $order->calculate_prices_and_taxes;
 191     $order->save;
 192   }
 193   return $order;
 194 }
 195
 196 sub create_purchase_order {
 197   my (%params) = @_;
 198
 199   my $record_type = 'purchase_order';
 200   my $orderitems = delete $params{orderitems} // _create_two_items($record_type);
 201   _check_items($orderitems, $record_type);
 202
 203   my $save = delete $params{save} // 0;
 204
 205   my $vendor = $params{vendor} // new_vendor(name => 'Testvendor')->save;
 206   die "illegal vendor" unless ref($vendor) eq 'SL::DB::Vendor';
 207
 208   my $order = SL::DB::Order->new(
 209     vendor_id    => delete $params{vendor_id}   // $vendor->id,
 210     taxzone_id   => delete $params{taxzone_id}  // $vendor->taxzone->id,
 211     currency_id  => delete $params{currency_id} // $::instance_conf->get_currency_id,
 212     taxincluded  => delete $params{taxincluded} // 0,
 213     transdate    => delete $params{transdate}   // DateTime->today,
 214     'closed'     => undef,
 215     orderitems   => $orderitems,
 216   );
 217   $order->assign_attributes(%params) if %params;
 218
 219   if ( $save ) {
 220     $order->calculate_prices_and_taxes; # not tested for purchase orders
 221     $order->save;
 222   }
 223   return $order;
 224 };
 225
 226 sub _check_items {
 227   my ($items, $record_type) = @_;
 228
 229   if  ( scalar @{$items} == 0 or grep { ref($_) ne $record_type_to_item_type{"$record_type"} } @{$items} ) {
 230     die "Error: items must be an arrayref of " . $record_type_to_item_type{"$record_type"} . "objects.";
 231   }
 232 }
 233
 234 sub create_invoice_item {
 235   my (%params) = @_;
 236
 237   return _create_item(record_type => 'sales_invoice', %params);
 238 }
 239
 240 sub create_order_item {
 241   my (%params) = @_;
 242
 243   return _create_item(record_type => 'sales_order', %params);
 244 }
 245
 246 sub create_delivery_order_item {
 247   my (%params) = @_;
 248
 249   return _create_item(record_type => 'sales_delivery_order', %params);
 250 }
 251
 252 sub _create_item {
 253   my (%params) = @_;
 254
 255   my $record_type = delete($params{record_type});
 256   my $part        = delete($params{part});
 257
 258   die "illegal record type: $record_type, must be one of: " . join(' ', keys %record_type_to_item_type) unless $record_type_to_item_type{ $record_type };
 259   die "part missing as param" unless $part && ref($part) eq 'SL::DB::Part';
 260
 261   my ($sellprice, $lastcost);
 262
 263   if ( $record_type =~ /^sales/ ) {
 264     $sellprice = delete $params{sellprice} // $part->sellprice;
 265     $lastcost  = delete $params{lastcost}  // $part->lastcost;
 266   } else {
 267     $sellprice = delete $params{sellprice} // $part->lastcost;
 268     $lastcost  = delete $params{lastcost}  // 0; # $part->lastcost;
 269   }
 270
 271   my $item = "$record_type_to_item_type{$record_type}"->new(
 272     parts_id    => $part->id,
 273     sellprice   => $sellprice,
 274     lastcost    => $lastcost,
 275     description => $part->description,
 276     unit        => $part->unit,
 277     qty         => $params{qty} || 5,
 278   );
 279   $item->assign_attributes(%params) if %params;
 280   return $item;
 281 }
 282
 283 sub _create_two_items {
 284   my ($record_type) = @_;
 285
 286   my $part1 = new_part(description => 'Testpart 1',
 287                        sellprice   => 12,
 288                       )->save;
 289   my $part2 = new_part(description => 'Testpart 2',
 290                        sellprice   => 10,
 291                       )->save;
 292   my $item1 = _create_item(record_type => $record_type, part => $part1, qty => 5);
 293   my $item2 = _create_item(record_type => $record_type, part => $part2, qty => 8);
 294   return [ $item1, $item2 ];
 295 }
 296
 297 sub create_project {
 298   my (%params) = @_;
 299   my $project = SL::DB::Project->new(
 300     projectnumber     => delete $params{projectnumber} // 1,
 301     description       => delete $params{description} // "Test project",
 302     active            => 1,
 303     valid             => 1,
 304     project_status_id => SL::DB::Manager::ProjectStatus->find_by(name => "running")->id,
 305     project_type_id   => SL::DB::Manager::ProjectType->find_by(description => "Standard")->id,
 306   )->save;
 307   $project->assign_attributes(%params) if %params;
 308   return $project;
 309 }
 310
 311 sub create_department {
 312   my (%params) = @_;
 313
 314   my $department = SL::DB::Department->new(
 315     'description' => delete $params{description} // 'Test Department',
 316   )->save;
 317
 318   $department->assign_attributes(%params) if %params;
 319   return $department;
 320
 321 }
 322
 323 sub create_ap_transaction {
 324   my (%params) = @_;
 325
 326   my $vendor = delete $params{vendor};
 327   if ( $vendor ) {
 328     die "vendor missing or not a SL::DB::Vendor object" unless ref($vendor) eq 'SL::DB::Vendor';
 329   } else {
 330     # use default SL/Dev vendor if it exists, or create a new one
 331     $vendor = SL::DB::Manager::Vendor->find_by(name => 'Testlieferant') // new_vendor->save;
 332   };
 333
 334   my $taxincluded = $params{taxincluded} // 1;
 335   delete $params{taxincluded};
 336
 337   my $bookings    = delete $params{bookings};
 338   # default bookings
 339   unless ( $bookings ) {
 340     my $chart_postage   = SL::DB::Manager::Chart->find_by(description => 'Porto');
 341     my $chart_telephone = SL::DB::Manager::Chart->find_by(description => 'Telefon');
 342     $bookings = [
 343                   {
 344                     chart  => $chart_postage,
 345                     amount => 1000,
 346                   },
 347                   {
 348                     chart  => $chart_telephone,
 349                     amount => $taxincluded ? 1190 : 1000,
 350                   },
 351                 ]
 352   };
 353
 354   # optional params:
 355   my $project_id         = delete $params{globalproject_id};
 356
 357   # if amount or netamount are given, then it compares them to the final values, and dies if they don't match
 358   my $expected_amount    = delete $params{amount};
 359   my $expected_netamount = delete $params{netamount};
 360
 361   my $dec = delete $params{dec} // 2;
 362
 363   my $today      = DateTime->today_local;
 364   my $transdate  = delete $params{transdate} // $today;
 365   die "transdate hat to be DateTime object" unless ref($transdate) eq 'DateTime';
 366
 367   my $gldate     = delete $params{gldate} // $today;
 368   die "gldate hat to be DateTime object" unless ref($gldate) eq 'DateTime';
 369
 370   my $ap_chart = delete $params{ap_chart} // SL::DB::Manager::Chart->find_by( accno => '1600' );
 371   die "no ap_chart found or not an AP chart" unless $ap_chart and $ap_chart->link eq 'AP';
 372
 373   my $ap_transaction = SL::DB::PurchaseInvoice->new(
 374     vendor_id        => $vendor->id,
 375     invoice          => 0,
 376     transactions     => [],
 377     globalproject_id => $project_id,
 378     invnumber        => delete $params{invnumber} // 'test ap_transaction',
 379     notes            => delete $params{notes}     // 'test ap_transaction',
 380     transdate        => $transdate,
 381     gldate           => $gldate,
 382     taxincluded      => $taxincluded,
 383     taxzone_id       => $vendor->taxzone_id, # taxzone_id shouldn't have any effect on ap transactions
 384     currency_id      => $::instance_conf->get_currency_id,
 385     type             => undef, # isn't set for ap
 386     employee_id      => SL::DB::Manager::Employee->current->id,
 387   );
 388   # assign any parameters that weren't explicitly handled above, e.g. itime
 389   $ap_transaction->assign_attributes(%params) if %params;
 390
 391   foreach my $booking ( @{$bookings} ) {
 392     my $chart = delete $booking->{chart};
 393     die "illegal chart" unless ref($chart) eq 'SL::DB::Chart';
 394
 395     my $tax = _transaction_tax_helper($booking, $chart, $transdate); # will die if tax can't be found
 396
 397     $ap_transaction->add_ap_amount_row(
 398       amount     => $booking->{amount}, # add_ap_amount_row expects the user input amount, does its own calculate_tax
 399       chart      => $chart,
 400       tax_id     => $tax->id,
 401       project_id => $booking->{project_id},
 402     );
 403   }
 404
 405   my $acc_trans_sum = sum map { $_->amount  } grep { $_->chart_link =~ 'AP_amount' } @{$ap_transaction->transactions};
 406   # $main::lxdebug->message(0, sprintf("accno: %s    amount: %s   chart_link: %s\n",
 407   #                                    $_->amount,
 408   #                                    $_->chart->accno,
 409   #                                    $_->chart_link
 410   #                                   )) foreach @{$ap_transaction->transactions};
 411
 412   # determine netamount and amount from the transactions that were added via bookings
 413   $ap_transaction->netamount( -1 * sum map { $_->amount  } grep { $_->chart_link =~ 'AP_amount' } @{$ap_transaction->transactions} );
 414   # $main::lxdebug->message(0, sprintf('found netamount %s', $ap_transaction->netamount));
 415
 416   my $taxamount = -1 * sum map { $_->amount  } grep { $_->chart_link =~ /tax/ } @{$ap_transaction->transactions};
 417   $ap_transaction->amount( $ap_transaction->netamount + $taxamount );
 418   # additional check, add up all transactions before AP-transaction is added
 419   my $refamount = -1 * sum map { $_->amount  } @{$ap_transaction->transactions};
 420   die "refamount = $refamount, ap_transaction->amount = " . $ap_transaction->amount unless $refamount == $ap_transaction->amount;
 421
 422   # if amount or netamount were passed as params, check if the values are still
 423   # the same after recalculating them from the acc_trans entries
 424   if (defined $expected_amount) {
 425     die "amount doesn't match acc_trans amounts: $expected_amount != " . $ap_transaction->amount unless $expected_amount == $ap_transaction->amount;
 426   }
 427   if (defined $expected_netamount) {
 428     die "netamount doesn't match acc_trans netamounts: $expected_netamount != " . $ap_transaction->netamount unless $expected_netamount == $ap_transaction->netamount;
 429   }
 430
 431   $ap_transaction->create_ap_row(chart => $ap_chart);
 432   $ap_transaction->save;
 433   # $main::lxdebug->message(0, sprintf("created ap_transaction with invnumber %s and trans_id %s",
 434   #                                     $ap_transaction->invnumber,
 435   #                                     $ap_transaction->id));
 436   return $ap_transaction;
 437 }
 438
 439 sub create_ar_transaction {
 440   my (%params) = @_;
 441
 442   my $customer = delete $params{customer};
 443   if ( $customer ) {
 444     die "customer missing or not a SL::DB::Customer object" unless ref($customer) eq 'SL::DB::Customer';
 445   } else {
 446     # use default SL/Dev vendor if it exists, or create a new one
 447     $customer = SL::DB::Manager::Customer->find_by(name => 'Testkunde') // new_customer->save;
 448   };
 449
 450   my $taxincluded = $params{taxincluded} // 1;
 451   delete $params{taxincluded};
 452
 453   my $bookings    = delete $params{bookings};
 454   # default bookings
 455   unless ( $bookings ) {
 456     my $chart_19 = SL::DB::Manager::Chart->find_by(accno => '8400');
 457     my $chart_7  = SL::DB::Manager::Chart->find_by(accno => '8300');
 458     my $chart_0  = SL::DB::Manager::Chart->find_by(accno => '8200');
 459     $bookings = [
 460                   {
 461                     chart  => $chart_19,
 462                     amount => $taxincluded ? 119 : 100,
 463                   },
 464                   {
 465                     chart  => $chart_7,
 466                     amount => $taxincluded ? 107 : 100,
 467                   },
 468                   {
 469                     chart  => $chart_0,
 470                     amount => 100,
 471                   },
 472                 ]
 473   };
 474
 475   # optional params:
 476   my $project_id = delete $params{globalproject_id};
 477
 478   # if amount or netamount are given, then it compares them to the final values, and dies if they don't match
 479   my $expected_amount    = delete $params{amount};
 480   my $expected_netamount = delete $params{netamount};
 481
 482   my $dec = delete $params{dec} // 2;
 483
 484   my $today      = DateTime->today_local;
 485   my $transdate  = delete $params{transdate} // $today;
 486   die "transdate hat to be DateTime object" unless ref($transdate) eq 'DateTime';
 487
 488   my $gldate     = delete $params{gldate} // $today;
 489   die "gldate hat to be DateTime object" unless ref($gldate) eq 'DateTime';
 490
 491   my $ar_chart = delete $params{ar_chart} // SL::DB::Manager::Chart->find_by( accno => '1400' );
 492   die "no ar_chart found or not an AR chart" unless $ar_chart and $ar_chart->link eq 'AR';
 493
 494   my $ar_transaction = SL::DB::Invoice->new(
 495     customer_id      => $customer->id,
 496     invoice          => 0,
 497     transactions     => [],
 498     globalproject_id => $project_id,
 499     invnumber        => delete $params{invnumber} // 'test ar_transaction',
 500     notes            => delete $params{notes}     // 'test ar_transaction',
 501     transdate        => $transdate,
 502     gldate           => $gldate,
 503     taxincluded      => $taxincluded,
 504     taxzone_id       => $customer->taxzone_id, # taxzone_id shouldn't have any effect on ar transactions
 505     currency_id      => $::instance_conf->get_currency_id,
 506     type             => undef, # isn't set for ar
 507     employee_id      => SL::DB::Manager::Employee->current->id,
 508   );
 509   # assign any parameters that weren't explicitly handled above, e.g. itime
 510   $ar_transaction->assign_attributes(%params) if %params;
 511
 512   foreach my $booking ( @{$bookings} ) {
 513     my $chart = delete $booking->{chart};
 514     die "illegal chart" unless ref($chart) eq 'SL::DB::Chart';
 515
 516     my $tax = _transaction_tax_helper($booking, $chart, $transdate); # will die if tax can't be found
 517
 518     $ar_transaction->add_ar_amount_row(
 519       amount     => $booking->{amount}, # add_ar_amount_row expects the user input amount, does its own calculate_tax
 520       chart      => $chart,
 521       tax_id     => $tax->id,
 522       project_id => $booking->{project_id},
 523     );
 524   }
 525
 526   my $acc_trans_sum = sum map { $_->amount  } grep { $_->chart_link =~ 'AR_amount' } @{$ar_transaction->transactions};
 527   # $main::lxdebug->message(0, sprintf("accno: %s    amount: %s   chart_link: %s\n",
 528   #                                    $_->amount,
 529   #                                    $_->chart->accno,
 530   #                                    $_->chart_link
 531   #                                   )) foreach @{$ar_transaction->transactions};
 532
 533   # determine netamount and amount from the transactions that were added via bookings
 534   $ar_transaction->netamount( 1 * sum map { $_->amount  } grep { $_->chart_link =~ 'AR_amount' } @{$ar_transaction->transactions} );
 535   # $main::lxdebug->message(0, sprintf('found netamount %s', $ar_transaction->netamount));
 536
 537   my $taxamount = 1 * sum map { $_->amount  } grep { $_->chart_link =~ /tax/ } @{$ar_transaction->transactions};
 538   $ar_transaction->amount( $ar_transaction->netamount + $taxamount );
 539   # additional check, add up all transactions before AP-transaction is added
 540   my $refamount = 1 * sum map { $_->amount  } @{$ar_transaction->transactions};
 541   die "refamount = $refamount, ar_transaction->amount = " . $ar_transaction->amount unless $refamount == $ar_transaction->amount;
 542
 543   # if amount or netamount were passed as params, check if the values are still
 544   # the same after recalculating them from the acc_trans entries
 545   if (defined $expected_amount) {
 546     die "amount doesn't match acc_trans amounts: $expected_amount != " . $ar_transaction->amount unless $expected_amount == $ar_transaction->amount;
 547   }
 548   if (defined $expected_netamount) {
 549     die "netamount doesn't match acc_trans netamounts: $expected_netamount != " . $ar_transaction->netamount unless $expected_netamount == $ar_transaction->netamount;
 550   }
 551
 552   $ar_transaction->create_ar_row(chart => $ar_chart);
 553   $ar_transaction->save;
 554   # $main::lxdebug->message(0, sprintf("created ar_transaction with invnumber %s and trans_id %s",
 555   #                                     $ar_transaction->invnumber,
 556   #                                     $ar_transaction->id));
 557   return $ar_transaction;
 558 }
 559
 560 sub create_gl_transaction {
 561   my (%params) = @_;
 562
 563   my $ob_transaction = delete $params{ob_transaction} // 0;
 564   my $cb_transaction = delete $params{cb_transaction} // 0;
 565   my $dec            = delete $params{rec} // 2;
 566
 567   my $taxincluded = defined $params{taxincluded} ? $params{taxincluded} : 1;
 568
 569   my $today      = DateTime->today_local;
 570   my $transdate  = delete $params{transdate} // $today;
 571   my $gldate     = delete $params{gldate}    // $today;
 572
 573   my $reference   = delete $params{reference}   // 'reference';
 574   my $description = delete $params{description} // 'description';
 575
 576   my $department_id = delete $params{department_id};
 577
 578   my $bookings = delete $params{bookings};
 579   unless ( $bookings && scalar @{$bookings} ) {
 580     # default bookings if left empty
 581     my $expense_chart = SL::DB::Manager::Chart->find_by(accno => '4660') or die "Can't find expense chart 4660\n"; # Reisekosten
 582     my $cash_chart    = SL::DB::Manager::Chart->find_by(accno => '1000') or die "Can't find cash chart 1000\n";    # Kasse
 583
 584     $taxincluded = 0;
 585
 586     $reference   = 'Reise';
 587     $description = 'Reise';
 588
 589     $bookings = [
 590                   {
 591                     chart  => $expense_chart, # has default tax of 19%
 592                     credit => 84.03,
 593                     taxkey => 9,
 594                   },
 595                   {
 596                     chart  => $cash_chart,
 597                     debit  => 100,
 598                     taxkey => 0,
 599                   },
 600     ];
 601   }
 602
 603   my $gl_transaction = SL::DB::GLTransaction->new(
 604     reference      => $reference,
 605     description    => $description,
 606     transdate      => $transdate,
 607     gldate         => $gldate,
 608     taxincluded    => $taxincluded,
 609     type           => undef,
 610     ob_transaction => $ob_transaction,
 611     cb_transaction => $cb_transaction,
 612     storno         => 0,
 613     storno_id      => undef,
 614     transactions   => [],
 615   );
 616   # assign any parameters that weren't explicitly handled above, e.g. itime
 617   $gl_transaction->assign_attributes(%params) if %params;
 618
 619   my @acc_trans;
 620   if ( scalar @{$bookings} ) {
 621     # there are several ways of determining the tax:
 622     # * tax_id : fetches SL::DB::Tax object via id (as used in dropdown in interface)
 623     # * tax : SL::DB::Tax object (where $tax->id = tax_id)
 624     # * taxkey : tax is determined from startdate
 625     # * none of the above defined: use the default tax for that chart
 626
 627     foreach my $booking ( @{$bookings} ) {
 628       my $chart = delete $booking->{chart};
 629       die "illegal chart" unless ref($chart) eq 'SL::DB::Chart';
 630
 631       die t8('Empty transaction!')
 632         unless $booking->{debit} or $booking->{credit}; # must exist and not be 0
 633       die t8('Cannot post transaction with a debit and credit entry for the same account!')
 634         if defined($booking->{debit}) and defined($booking->{credit});
 635
 636       my $tax = _transaction_tax_helper($booking, $chart, $transdate); # will die if tax can't be found
 637
 638       $gl_transaction->add_chart_booking(
 639         chart      => $chart,
 640         debit      => $booking->{debit},
 641         credit     => $booking->{credit},
 642         tax_id     => $tax->id,
 643         source     => $booking->{source} // '',
 644         memo       => $booking->{memo}   // '',
 645         project_id => $booking->{project_id}
 646       );
 647     }
 648   };
 649
 650   $gl_transaction->post;
 651
 652   return $gl_transaction;
 653 }
 654
 655 sub _transaction_tax_helper {
 656   # checks for hash-entries with key tax, tax_id or taxkey
 657   # returns an SL::DB::Tax object
 658   # can be used for booking hashref in ar_transaction, ap_transaction and gl_transaction
 659   # will modify hashref, e.g. removing taxkey if tax_id was also supplied
 660
 661   my ($booking, $chart, $transdate) = @_;
 662
 663   die "_transaction_tax_helper: chart missing"     unless $chart && ref($chart) eq 'SL::DB::Chart';
 664   die "_transaction_tax_helper: transdate missing" unless $transdate && ref($transdate) eq 'DateTime';
 665
 666   my $tax;
 667
 668   if ( defined $booking->{tax_id} ) { # tax_id may be 0
 669     delete $booking->{taxkey}; # ignore any taxkeys that may have been added, tax_id has precedence
 670     $tax = SL::DB::Tax->new(id => $booking->{tax_id})->load( with => [ 'chart' ] );
 671   } elsif ( $booking->{tax} ) {
 672     die "illegal tax entry" unless ref($booking->{tax}) eq 'SL::DB::Tax';
 673     $tax = $booking->{tax};
 674   } elsif ( defined $booking->{taxkey} ) {
 675     # If a taxkey is given, find the taxkey entry for that chart that
 676     # matches the stored taxkey and with the correct transdate. This will only work
 677     # if kivitendo has that taxkey configured for that chart, i.e. it should barf if
 678     # e.g. the bank chart is called with taxkey 3.
 679
 680     # example query:
 681     #   select *
 682     #     from taxkeys
 683     #    where     taxkey_id = 3
 684     #          and chart_id = (select id from chart where accno = '8400')
 685     #          and startdate <= '2018-01-01'
 686     # order by startdate desc
 687     #    limit 1;
 688
 689     my $taxkey = SL::DB::Manager::TaxKey->get_first(
 690       query        => [ and => [ chart_id  => $chart->id,
 691                                  startdate => { le => $transdate },
 692                                  taxkey    => $booking->{taxkey}
 693                                ]
 694                       ],
 695       sort_by      => "startdate DESC",
 696       limit        => 1,
 697       with_objects => [ qw(tax) ],
 698     );
 699     die sprintf("Chart %s doesn't have a taxkey chart configured for taxkey %s", $chart->accno, $booking->{taxkey})
 700       unless $taxkey;
 701
 702     $tax = $taxkey->tax;
 703   } else {
 704     # use default tax for that chart if neither tax_id, tax or taxkey were defined
 705     my $active_taxkey = $chart->get_active_taxkey($transdate);
 706     $tax = $active_taxkey->tax;
 707     # $main::lxdebug->message(0, sprintf("found default taxrate %s for chart %s", $tax->rate, $chart->displayable_name));
 708   };
 709
 710   die "no tax" unless $tax && ref($tax) eq 'SL::DB::Tax';
 711   return $tax;
 712 };
 713
 714 1;
 715
 716 __END__
 717
 718 =head1 NAME
 719
 720 SL::Dev::Record - create record objects for testing, with minimal defaults
 721
 722 =head1 FUNCTIONS
 723
 724 =head2 C<create_sales_invoice %PARAMS>
 725
 726 Creates a new sales invoice (table ar, invoice = 1).
 727
 728 If neither customer nor invoiceitems are passed as params a customer and two
 729 parts are created and used for building the invoice.
 730
 731 Minimal usage example:
 732
 733   my $invoice = SL::Dev::Record::create_sales_invoice();
 734
 735 Example with params:
 736
 737   my $invoice2 = SL::Dev::Record::create_sales_invoice(
 738     invnumber   => 777,
 739     transdate   => DateTime->today->subtract(days => 7),
 740     taxincluded => 1,
 741   );
 742
 743 =head2 C<create_credit_note %PARAMS>
 744
 745 Create a credit note (sales). Use positive quantities when adding items.
 746
 747 Example including creation of parts and of credit_note:
 748
 749   my $part1 = SL::Dev::Part::new_part(   partnumber => 'T4254')->save;
 750   my $part2 = SL::Dev::Part::new_service(partnumber => 'Serv1')->save;
 751   my $credit_note = SL::Dev::Record::create_credit_note(
 752     invnumber    => '34',
 753     taxincluded  => 0,
 754     invoiceitems => [ SL::Dev::Record::create_invoice_item(part => $part1, qty =>  3, sellprice => 70),
 755                       SL::Dev::Record::create_invoice_item(part => $part2, qty => 10, sellprice => 50),
 756                     ]
 757   );
 758
 759 =head2 C<create_sales_order %PARAMS>
 760
 761 Examples:
 762
 763 Create a sales order and save it directly via rose, without running
 764 calculate_prices_and_taxes:
 765
 766   my $order = SL::Dev::Record::create_sales_order()->save;
 767
 768 Let create_sales_order run calculate_prices_and_taxes and save:
 769
 770   my $order = SL::Dev::Record::create_sales_order(save => 1);
 771
 772
 773 Example including creation of part and of sales order:
 774
 775   my $part1 = SL::Dev::Part::new_part(   partnumber => 'T4254')->save;
 776   my $part2 = SL::Dev::Part::new_service(partnumber => 'Serv1')->save;
 777   my $order = SL::Dev::Record::create_sales_order(
 778     save         => 1,
 779     taxincluded  => 0,
 780     orderitems => [ SL::Dev::Record::create_order_item(part => $part1, qty =>  3, sellprice => 70),
 781                     SL::Dev::Record::create_order_item(part => $part2, qty => 10, sellprice => 50),
 782                   ]
 783   );
 784
 785 Example: create 100 orders with the same part for 100 new customers:
 786
 787   my $part1 = SL::Dev::Part::new_part(partnumber => 'T6256')->save;
 788   SL::Dev::Record::create_sales_order(
 789     save         => 1,
 790     taxincluded  => 0,
 791     orderitems => [ SL::Dev::Record::create_order_item(part => $part1, qty => 1, sellprice => 9) ]
 792   ) for 1 .. 100;
 793
 794 =head2 C<create_purchase_order %PARAMS>
 795
 796 See comments for C<create_sales_order>.
 797
 798 Example:
 799
 800   my $purchase_order = SL::Dev::Record::create_purchase_order(save => 1);
 801
 802
 803 =head2 C<create_item %PARAMS>
 804
 805 Creates an item from a part object that can be added to a record.
 806
 807 Required params:
 808
 809   record_type (sales_invoice, sales_order, sales_delivery_order)
 810   part        (an SL::DB::Part object)
 811
 812 Example including creation of part and of invoice:
 813
 814   my $part    = SL::Dev::Part::new_part(  partnumber  => 'T4254')->save;
 815   my $item    = SL::Dev::Record::create_invoice_item(part => $part, qty => 2.5);
 816   my $invoice = SL::Dev::Record::create_sales_invoice(
 817     taxincluded  => 0,
 818     invoiceitems => [ $item ],
 819   );
 820
 821 =head2 C<create_project %PARAMS>
 822
 823 Creates a default project.
 824
 825 Minimal example, creating a project with status "running" and type "Standard":
 826
 827   my $project = SL::Dev::Record::create_project();
 828
 829   $project = SL::Dev::Record::create_project(
 830     projectnumber => 'p1',
 831     description   => 'Test project',
 832   )
 833
 834 If C<$params{description}> or C<$params{projectnumber}> exists, this will override the
 835 default value 'Test project'.
 836
 837 C<%params> should only contain alterable keys from the object Project.
 838
 839 =head2 C<create_department %PARAMS>
 840
 841 Creates a default department.
 842
 843 Minimal example:
 844
 845   my $department = SL::Dev::Record::create_department();
 846
 847   my $department = SL::Dev::Record::create_department(
 848     description => 'Hawaii',
 849   )
 850
 851 If C<$params{description}> exists, this will override the
 852 default value 'Test Department'.
 853
 854 C<%params> should only contain alterable keys from the object Department.
 855
 856 =head2 C<create_ap_transaction %PARAMS>
 857
 858 Creates a new AP transaction (table ap, invoice = 0), and will try to add as
 859 many defaults as possible.
 860
 861 Possible parameters:
 862  * vendor (SL::DB::Vendor object, defaults to SL::Dev default vendor)
 863  * taxincluded (0 or 1, defaults to 1)
 864  * transdate (DateTime object, defaults to current date)
 865  * bookings (arrayref for the charts to be booked, see examples below)
 866  * amount (to check if final amount matches this amount)
 867  * netamount (to check if final amount matches this amount)
 868  * dec (number of decimals to round to, defaults to 2)
 869  * ap_chart (SL::DB::Chart object, default to accno 1600)
 870  * invnumber (defaults to 'test ap_transaction')
 871  * notes (defaults to 'test ap_transaction')
 872  * globalproject_id
 873
 874 Currently doesn't support exchange rates.
 875
 876 Minimal usage example, creating an AP transaction with a default vendor and
 877 default bookings (telephone, postage):
 878
 879   use SL::Dev::Record qw(create_ap_transaction);
 880   my $invoice = create_ap_transaction();
 881
 882 Create an AP transaction with a specific vendor and specific charts:
 883
 884   my $vendor = SL::Dev::CustomerVendor::new_vendor(name => 'My Vendor')->save;
 885   my $chart_postage   = SL::DB::Manager::Chart->find_by(description => 'Porto');
 886   my $chart_telephone = SL::DB::Manager::Chart->find_by(description => 'Telefon');
 887
 888   my $ap_transaction = create_ap_transaction(
 889     vendor      => $vendor,
 890     invnumber   => 'test invoice taxincluded',
 891     taxincluded => 1,
 892     amount      => 2190, # optional param for checking whether final amount matches
 893     netamount   => 2000, # optional param for checking whether final netamount matches
 894     bookings    => [
 895                      {
 896                        chart  => $chart_postage,
 897                        amount => 1000,
 898                      },
 899                      {
 900                        chart  => $chart_telephone,
 901                        amount => 1190,
 902                      },
 903                    ]
 904   );
 905
 906 Or the same example with tax not included, but an old transdate and old taxrate (16%):
 907
 908   my $ap_transaction = create_ap_transaction(
 909     vendor      => $vendor,
 910     invnumber   => 'test invoice tax not included',
 911     transdate   => DateTime->new(year => 2000, month => 10, day => 1),
 912     taxincluded => 0,
 913     amount      => 2160, # optional param for checking whether final amount matches
 914     netamount   => 2000, # optional param for checking whether final netamount matches
 915     bookings    => [
 916                      {
 917                        chart  => $chart_postage,
 918                        amount => 1000,
 919                      },
 920                      {
 921                        chart  => $chart_telephone,
 922                        amount => 1000,
 923                      },
 924                  ]
 925   );
 926
 927 Don't use the default tax, e.g. postage with 19%:
 928
 929   my $tax_9          = SL::DB::Manager::Tax->find_by(taxkey => 9, rate => 0.19);
 930   my $chart_postage  = SL::DB::Manager::Chart->find_by(description => 'Porto');
 931   my $ap_transaction = create_ap_transaction(
 932     invnumber   => 'postage with tax',
 933     taxincluded => 0,
 934     bookings    => [
 935                      {
 936                        chart  => $chart_postage,
 937                        amount => 1000,
 938                        tax    => $tax_9,
 939                      },
 940                    ],
 941   );
 942
 943 =head2 C<create_ar_transaction %PARAMS>
 944
 945 See C<create_ap_transaction>, except use customer instead of vendor.
 946
 947 =head2 C<create_gl_transaction %PARAMS>
 948
 949 Creates a new GL transaction (table gl), which is basically a wrapper around
 950 SL::DB::GLTransaction->new(...) and add_chart_booking and post, while setting
 951 as many defaults as possible.
 952
 953 Possible parameters:
 954
 955  * taxincluded (0 or 1, defaults to 1)
 956  * transdate (DateTime object, defaults to current date)
 957  * dec (number of decimals to round to, defaults to 2)
 958  * bookings (arrayref for the charts and taxes to be booked, see examples below)
 959
 960 bookings must include a least:
 961
 962  * chart as an SL::DB::Chart object
 963  * credit or debit, as positive numbers
 964  * tax_id, tax (an SL::DB::Tax object) or taxkey (e.g. 9)
 965
 966 Can't be used to create storno transactions.
 967
 968 Minimal usage example, using all the defaults, creating a GL transaction with
 969 travel expenses:
 970
 971   use SL::Dev::Record qw(create_gl_transaction);
 972   $gl_transaction = create_gl_transaction();
 973
 974 Create a GL transaction with a specific charts and taxes (the default taxes for
 975 those charts are used if none are explicitly given in bookings):
 976
 977   my $cash           = SL::DB::Manager::Chart->find_by( description => 'Kasse'          );
 978   my $betriebsbedarf = SL::DB::Manager::Chart->find_by( description => 'Betriebsbedarf' );
 979   $gl_transaction = create_gl_transaction(
 980     reference   => 'betriebsbedarf',
 981     taxincluded => 1,
 982     bookings    => [
 983                      {
 984                        chart  => $betriebsbedarf,
 985                        memo   => 'foo 1',
 986                        source => 'foo 1',
 987                        credit => 119,
 988                      },
 989                      {
 990                        chart  => $betriebsbedarf,
 991                        memo   => 'foo 2',
 992                        source => 'foo 2',
 993                        credit => 119,
 994                      },
 995                      {
 996                        chart  => $cash,
 997                        debit  => 238,
 998                        memo   => 'foo 1+2',
 999                        source => 'foo 1+2',
1000                      },
1001                    ],
1002   );
1003
1004
1005 =head1 BUGS
1006
1007 Nothing here yet.
1008
1009 =head1 AUTHOR
1010
1011 G. Richardson E<lt>grichardson@kivitec.deE<gt>
1012
1013 =cut