SL/DB/Order.pm

   1 package SL::DB::Order;
   2
   3 use utf8;
   4 use strict;
   5
   6 use Carp;
   7 use DateTime;
   8 use List::Util qw(max);
   9 use List::MoreUtils qw(any);
  10
  11 use SL::DBUtils ();
  12 use SL::DB::PurchaseBasketItem;
  13 use SL::DB::MetaSetup::Order;
  14 use SL::DB::Manager::Order;
  15 use SL::DB::Helper::Attr;
  16 use SL::DB::Helper::AttrHTML;
  17 use SL::DB::Helper::AttrSorted;
  18 use SL::DB::Helper::FlattenToForm;
  19 use SL::DB::Helper::LinkedRecords;
  20 use SL::DB::Helper::PriceTaxCalculator;
  21 use SL::DB::Helper::PriceUpdater;
  22 use SL::DB::Helper::TypeDataProxy;
  23 use SL::DB::Helper::TransNumberGenerator;
  24 use SL::DB::Helper::Payment qw(forex);
  25 use SL::DB::Helper::RecordLink qw(RECORD_ID RECORD_TYPE_REF RECORD_ITEM_ID RECORD_ITEM_TYPE_REF);
  26 use SL::Helper::Flash;
  27 use SL::Locale::String qw(t8);
  28 use SL::RecordLinks;
  29 use Rose::DB::Object::Helpers qw(as_tree strip);
  30
  31 use SL::DB::Order::TypeData qw(:types validate_type);
  32 use SL::DB::Reclamation::TypeData qw(:types);
  33
  34 __PACKAGE__->meta->add_relationship(
  35   orderitems => {
  36     type         => 'one to many',
  37     class        => 'SL::DB::OrderItem',
  38     column_map   => { id => 'trans_id' },
  39     manager_args => {
  40       with_objects => [ 'part' ]
  41     }
  42   },
  43   periodic_invoices_config => {
  44     type                   => 'one to one',
  45     class                  => 'SL::DB::PeriodicInvoicesConfig',
  46     column_map             => { id => 'oe_id' },
  47   },
  48   custom_shipto            => {
  49     type                   => 'one to one',
  50     class                  => 'SL::DB::Shipto',
  51     column_map             => { id => 'trans_id' },
  52     query_args             => [ module => 'OE' ],
  53   },
  54   exchangerate_obj         => {
  55     type                   => 'one to one',
  56     class                  => 'SL::DB::Exchangerate',
  57     column_map             => { currency_id => 'currency_id', transdate => 'transdate' },
  58   },
  59   phone_notes => {
  60     type         => 'one to many',
  61     class        => 'SL::DB::Note',
  62     column_map   => { id => 'trans_id' },
  63     query_args   => [ trans_module => 'oe' ],
  64     manager_args => {
  65       with_objects => [ 'employee' ],
  66       sort_by      => 'notes.itime',
  67     }
  68   },
  69   order_version => {
  70     type                   => 'one to many',
  71     class                  => 'SL::DB::OrderVersion',
  72     column_map             => { id => 'oe_id' },
  73   },
  74 );
  75
  76 SL::DB::Helper::Attr::make(__PACKAGE__, daily_exchangerate => 'numeric');
  77
  78 __PACKAGE__->meta->initialize;
  79
  80 __PACKAGE__->attr_html('notes');
  81 __PACKAGE__->attr_sorted('items');
  82
  83 __PACKAGE__->before_save('_before_save_set_ord_quo_number');
  84 __PACKAGE__->before_save('_before_save_create_new_project');
  85 __PACKAGE__->before_save('_before_save_remove_empty_custom_shipto');
  86 __PACKAGE__->before_save('_before_save_set_custom_shipto_module');
  87 __PACKAGE__->after_save('_after_save_link_records');
  88 __PACKAGE__->after_save('_after_save_close_reachable_intakes'); # uses linked records (order matters)
  89 __PACKAGE__->before_save('_before_save_delete_from_purchase_basket');
  90
  91 # hooks
  92
  93 sub _before_save_set_ord_quo_number {
  94   my ($self) = @_;
  95
  96   # ordnumber is 'NOT NULL'. Therefore make sure it's always set to at
  97   # least an empty string, even if we're saving a quotation.
  98   $self->ordnumber('') if !$self->ordnumber;
  99
 100   $self->create_trans_number if !$self->record_number;
 101
 102   return 1;
 103 }
 104 sub _before_save_create_new_project {
 105   my ($self) = @_;
 106
 107   # force new project, if not set yet
 108   if ($::instance_conf->get_order_always_project && !$self->globalproject_id && ($self->type eq SALES_ORDER_TYPE())) {
 109
 110     die t8("Error while creating project with project number of new order number, project number #1 already exists!", $self->ordnumber)
 111       if SL::DB::Manager::Project->find_by(projectnumber => $self->ordnumber);
 112
 113     eval {
 114       my $new_project = SL::DB::Project->new(
 115           projectnumber     => $self->ordnumber,
 116           description       => $self->customer->name,
 117           customer_id       => $self->customer->id,
 118           active            => 1,
 119           project_type_id   => $::instance_conf->get_project_type_id,
 120           project_status_id => $::instance_conf->get_project_status_id,
 121           );
 122        $new_project->save;
 123        $self->globalproject_id($new_project->id);
 124     } or die t8('Could not create new project #1', $@);
 125   }
 126   return 1;
 127 }
 128
 129
 130 sub _before_save_remove_empty_custom_shipto {
 131   my ($self) = @_;
 132
 133   $self->custom_shipto(undef) if $self->custom_shipto && $self->custom_shipto->is_empty;
 134
 135   return 1;
 136 }
 137
 138 sub _before_save_set_custom_shipto_module {
 139   my ($self) = @_;
 140
 141   $self->custom_shipto->module('OE') if $self->custom_shipto;
 142
 143   return 1;
 144 }
 145
 146 sub _after_save_link_records {
 147   my ($self) = @_;
 148
 149   my @allowed_record_sources = qw(SL::DB::Reclamation SL::DB::Order SL::DB::EmailJournal);
 150   my @allowed_item_sources = qw(SL::DB::ReclamationItem SL::DB::OrderItem);
 151
 152   SL::DB::Helper::RecordLink::link_records(
 153     $self,
 154     \@allowed_record_sources,
 155     \@allowed_item_sources,
 156   );
 157
 158   return 1;
 159 }
 160
 161 sub _after_save_close_reachable_intakes {
 162   my ($self) = @_;
 163
 164   # Close reachable sales order intakes in the from-workflow if this is a sales order
 165   if (SALES_ORDER_TYPE() eq $self->type) {
 166     my $lr = $self->linked_records(direction => 'from', recursive => 1);
 167     $lr    = [grep { 'SL::DB::Order' eq ref $_ && !$_->closed && $_->is_type(SALES_ORDER_INTAKE_TYPE()) } @$lr];
 168     if (@$lr) {
 169       SL::DB::Manager::Order->update_all(set   => {closed => 1},
 170                                          where => [id => [map {$_->id} @$lr]]);
 171     }
 172   }
 173
 174   return 1;
 175 }
 176
 177 sub _before_save_delete_from_purchase_basket {
 178   my ($self) = @_;
 179
 180   my @basket_item_ids =
 181     grep { defined($_) && $_ ne ''}
 182     map { $_->{basket_item_id} }
 183     $self->orderitems;
 184   return 1 unless scalar @basket_item_ids;
 185
 186   # check if all items are still in the basket
 187   my $basket_item_count = SL::DB::Manager::PurchaseBasketItem->get_all_count(
 188     where => [ id => \@basket_item_ids ]
 189   );
 190   if ($basket_item_count != scalar @basket_item_ids) {
 191     die "Error while saving order: some items are not in the purchase basket anymore.";
 192   }
 193
 194   if (scalar @basket_item_ids) {
 195     SL::DB::Manager::PurchaseBasketItem->delete_all(
 196       where => [ id => \@basket_item_ids]
 197     );
 198   }
 199
 200   return 1;
 201 }
 202
 203 # methods
 204
 205 sub items { goto &orderitems; }
 206 sub add_items { goto &add_orderitems; }
 207 sub record_number { goto &number; }
 208
 209 sub type {
 210   my $self = shift;
 211   SL::DB::Order::TypeData::validate_type($self->record_type);
 212   return $self->record_type;
 213 }
 214
 215 sub is_type {
 216   return shift->type eq shift;
 217 }
 218
 219 sub quotation {
 220   my $type = $_[0]->type();
 221   any { $type eq $_ } (
 222     SALES_ORDER_INTAKE_TYPE(),
 223     SALES_QUOTATION_TYPE(),
 224     REQUEST_QUOTATION_TYPE(),
 225     PURCHASE_QUOTATION_INTAKE_TYPE(),
 226   );
 227 }
 228
 229 sub intake {
 230   my $type = $_[0]->type();
 231   any { $type eq $_ } (
 232     SALES_ORDER_INTAKE_TYPE(),
 233     PURCHASE_QUOTATION_INTAKE_TYPE(),
 234   );
 235 }
 236
 237 sub deliverydate {
 238   # oe doesn't have deliverydate, but it does have reqdate.
 239   # But this has a different meaning for sales quotations.
 240   # deliverydate can be used to determine tax if tax_point isn't set.
 241
 242   return $_[0]->reqdate if $_[0]->type ne SALES_QUOTATION_TYPE();
 243 }
 244
 245 sub effective_tax_point {
 246   my ($self) = @_;
 247
 248   return $self->tax_point || $self->deliverydate || $self->transdate;
 249 }
 250
 251 sub displayable_type {
 252   my ($self) = @_;
 253   return $self->type_data->text('type');
 254 }
 255
 256 sub displayable_name {
 257   join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
 258 };
 259
 260 sub is_sales {
 261   croak 'not an accessor' if @_ > 1;
 262   $_[0]->type_data->properties('is_customer');
 263 }
 264
 265 sub daily_exchangerate {
 266   my ($self, $val) = @_;
 267
 268   return 1 if $self->currency_id == $::instance_conf->get_currency_id;
 269
 270   my $rate = (any { $self->is_type($_) } (SALES_QUOTATION_TYPE(), SALES_ORDER_TYPE()))      ? 'buy'
 271            : (any { $self->is_type($_) } (REQUEST_QUOTATION_TYPE(), PURCHASE_ORDER_TYPE())) ? 'sell'
 272            : undef;
 273   return if !$rate;
 274
 275   if (defined $val) {
 276     croak t8('exchange rate has to be positive') if $val <= 0;
 277     if (!$self->exchangerate_obj) {
 278       $self->exchangerate_obj(SL::DB::Exchangerate->new(
 279         currency_id => $self->currency_id,
 280         transdate   => $self->transdate,
 281         $rate       => $val,
 282       ));
 283     } elsif (!defined $self->exchangerate_obj->$rate) {
 284       $self->exchangerate_obj->$rate($val);
 285     } else {
 286       croak t8('exchange rate already exists, no update allowed');
 287     }
 288   }
 289   return $self->exchangerate_obj->$rate if $self->exchangerate_obj;
 290 }
 291
 292 sub invoices {
 293   my $self   = shift;
 294   my %params = @_;
 295
 296   if ($self->quotation) {
 297     return [];
 298   } else {
 299     require SL::DB::Invoice;
 300     return SL::DB::Manager::Invoice->get_all(
 301       query => [
 302         ordnumber => $self->ordnumber,
 303         @{ $params{query} || [] },
 304       ]
 305     );
 306   }
 307 }
 308
 309 sub displayable_state {
 310   my ($self) = @_;
 311
 312   return $self->closed ? $::locale->text('closed') : $::locale->text('open');
 313 }
 314
 315 sub abschlag_invoices {
 316   return shift()->invoices(query => [ abschlag => 1 ]);
 317 }
 318
 319 sub end_invoice {
 320   return shift()->invoices(query => [ abschlag => 0 ]);
 321 }
 322
 323 sub convert_to_invoice {
 324   my ($self, %params) = @_;
 325
 326   croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
 327
 328   my $invoice;
 329   if (!$self->db->with_transaction(sub {
 330     require SL::DB::Invoice;
 331     $invoice = SL::DB::Invoice->new_from($self, %params)->post || die;
 332     $self->update_attributes(closed => 1);
 333     1;
 334   })) {
 335     return undef;
 336   }
 337
 338   return $invoice;
 339 }
 340
 341 sub convert_to_delivery_order {
 342   my ($self, @args) = @_;
 343
 344   my $delivery_order;
 345   if (!$self->db->with_transaction(sub {
 346     require SL::DB::DeliveryOrder;
 347     $delivery_order = SL::DB::DeliveryOrder->new_from($self, @args);
 348     $delivery_order->save;
 349
 350     $self->update_attributes(delivered => 1) unless $::instance_conf->get_shipped_qty_require_stock_out;
 351     1;
 352   })) {
 353     return undef;
 354   }
 355
 356   return $delivery_order;
 357 }
 358
 359 sub convert_to_reclamation {
 360   my ($self, %params) = @_;
 361   $params{destination_type} = $self->is_sales ? SALES_RECLAMATION_TYPE()
 362                                               : PURCHASE_RECLAMATION_TYPE();
 363
 364   require SL::DB::Reclamation;
 365   my $reclamation = SL::DB::Reclamation->new_from($self, %params);
 366
 367   return $reclamation;
 368 }
 369
 370 sub _clone_orderitem_cvar {
 371   my ($cvar) = @_;
 372
 373   my $cloned = $_->clone_and_reset;
 374   $cloned->sub_module('orderitems');
 375
 376   return $cloned;
 377 }
 378
 379 sub create_from_purchase_basket {
 380   my ($class, $basket_item_ids, $vendor_item_ids, $vendor_id) = @_;
 381
 382   my ($vendor, $employee);
 383   $vendor   = SL::DB::Manager::Vendor->find_by(id => $vendor_id);
 384   $employee = SL::DB::Manager::Employee->current;
 385
 386   my @orderitem_maps = (); # part, qty, orderer_id
 387   if ($basket_item_ids && scalar @{ $basket_item_ids}) {
 388     my $basket_items = SL::DB::Manager::PurchaseBasketItem->get_all(
 389       query => [ id => $basket_item_ids ],
 390       with_objects => ['part'],
 391     );
 392     push @orderitem_maps, map {{
 393         basket_item_id => $_->id,
 394         part       => $_->part,
 395         qty        => $_->qty,
 396         orderer_id => $_->orderer_id,
 397       }} @{$basket_items};
 398   }
 399   if ($vendor_item_ids && scalar @{ $vendor_item_ids}) {
 400     my $vendor_items = SL::DB::Manager::Part->get_all(
 401       query => [ id => $vendor_item_ids ] );
 402     push @orderitem_maps, map {{
 403         basket_item_id => undef,
 404         part       => $_,
 405         qty        => $_->order_qty || 1,
 406         orderer_id => $employee->id,
 407       }} @{$vendor_items};
 408   }
 409
 410   my $order = $class->new(
 411     vendor_id               => $vendor->id,
 412     employee_id             => $employee->id,
 413     intnotes                => $vendor->notes,
 414     salesman_id             => $employee->id,
 415     payment_id              => $vendor->payment_id,
 416     delivery_term_id        => $vendor->delivery_term_id,
 417     taxzone_id              => $vendor->taxzone_id,
 418     currency_id             => $vendor->currency_id,
 419     transdate               => DateTime->today_local,
 420     record_type             => PURCHASE_ORDER_TYPE(),
 421   );
 422
 423   my @order_items;
 424   my $i = 0;
 425   foreach my $orderitem_map (@orderitem_maps) {
 426     $i++;
 427     my $part = $orderitem_map->{part};
 428     my $qty = $orderitem_map->{qty};
 429     my $orderer_id = $orderitem_map->{orderer_id};
 430
 431     my $order_item = SL::DB::OrderItem->new(
 432       part                => $part,
 433       qty                 => $qty,
 434       unit                => $part->unit,
 435       description         => $part->description,
 436       price_factor_id     => $part->price_factor_id,
 437       price_factor        =>
 438         $part->price_factor_id ? $part->price_factor->factor
 439                                : '',
 440       orderer_id          => $orderer_id,
 441       position            => $i,
 442     );
 443     $order_item->{basket_item_id} = $orderitem_map->{basket_item_id};
 444
 445     my $price_source  = SL::PriceSource->new(
 446       record_item => $order_item, record => $order);
 447     $order_item->sellprice(
 448       $price_source->best_price ? $price_source->best_price->price
 449                                 : 0);
 450     $order_item->active_price_source(
 451       $price_source->best_price ? $price_source->best_price->source
 452                                 : '');
 453     push @order_items, $order_item;
 454   }
 455
 456   $order->assign_attributes(orderitems => \@order_items);
 457
 458   $order->calculate_prices_and_taxes;
 459
 460   foreach my $item(@{ $order->orderitems }){
 461     $item->parse_custom_variable_values;
 462     $item->{custom_variables} = \@{ $item->cvars_by_config };
 463   }
 464
 465   return $order;
 466 }
 467
 468 sub new_from {
 469   my ($class, $source, %params) = @_;
 470
 471   unless (any {ref($source) eq $_} qw(
 472     SL::DB::Order
 473     SL::DB::Reclamation
 474   )) {
 475     croak("Unsupported source object type '" . ref($source) . "'");
 476   }
 477   croak("A destination type must be given as parameter")         unless $params{destination_type};
 478
 479   my $destination_type  = delete $params{destination_type};
 480
 481   my @from_tos = (
 482     { from => SALES_QUOTATION_TYPE(),             to => SALES_ORDER_TYPE(),                 abbr => 'sqso'   },
 483     { from => REQUEST_QUOTATION_TYPE(),           to => PURCHASE_ORDER_TYPE(),              abbr => 'rqpo'   },
 484     { from => SALES_QUOTATION_TYPE(),             to => SALES_QUOTATION_TYPE(),             abbr => 'sqsq'   },
 485     { from => SALES_ORDER_TYPE(),                 to => SALES_ORDER_TYPE(),                 abbr => 'soso'   },
 486     { from => REQUEST_QUOTATION_TYPE(),           to => REQUEST_QUOTATION_TYPE(),           abbr => 'rqrq'   },
 487     { from => PURCHASE_ORDER_TYPE(),              to => PURCHASE_ORDER_TYPE(),              abbr => 'popo'   },
 488     { from => SALES_ORDER_TYPE(),                 to => PURCHASE_ORDER_TYPE(),              abbr => 'sopo'   },
 489     { from => PURCHASE_ORDER_TYPE(),              to => SALES_ORDER_TYPE(),                 abbr => 'poso'   },
 490     { from => SALES_ORDER_TYPE(),                 to => SALES_QUOTATION_TYPE(),             abbr => 'sosq'   },
 491     { from => PURCHASE_ORDER_TYPE(),              to => REQUEST_QUOTATION_TYPE(),           abbr => 'porq'   },
 492     { from => REQUEST_QUOTATION_TYPE(),           to => SALES_QUOTATION_TYPE(),             abbr => 'rqsq'   },
 493     { from => REQUEST_QUOTATION_TYPE(),           to => SALES_ORDER_TYPE(),                 abbr => 'rqso'   },
 494     { from => SALES_QUOTATION_TYPE(),             to => REQUEST_QUOTATION_TYPE(),           abbr => 'sqrq'   },
 495     { from => SALES_ORDER_TYPE(),                 to => REQUEST_QUOTATION_TYPE(),           abbr => 'sorq'   },
 496     { from => SALES_RECLAMATION_TYPE(),           to => SALES_ORDER_TYPE(),                 abbr => 'srso'   },
 497     { from => PURCHASE_RECLAMATION_TYPE(),        to => PURCHASE_ORDER_TYPE(),              abbr => 'prpo'   },
 498     { from => SALES_ORDER_INTAKE_TYPE(),          to => SALES_ORDER_INTAKE_TYPE(),          abbr => 'soisoi' },
 499     { from => SALES_ORDER_INTAKE_TYPE(),          to => SALES_QUOTATION_TYPE(),             abbr => 'soisq'  },
 500     { from => SALES_ORDER_INTAKE_TYPE(),          to => REQUEST_QUOTATION_TYPE(),           abbr => 'soirq'  },
 501     { from => SALES_ORDER_INTAKE_TYPE(),          to => SALES_ORDER_TYPE(),                 abbr => 'soiso'  },
 502     { from => SALES_ORDER_INTAKE_TYPE(),          to => PURCHASE_ORDER_TYPE(),              abbr => 'soipo'  },
 503     { from => SALES_QUOTATION_TYPE(),             to => SALES_ORDER_INTAKE_TYPE(),          abbr => 'sqsoi'  },
 504     { from => PURCHASE_QUOTATION_INTAKE_TYPE(),   to => PURCHASE_QUOTATION_INTAKE_TYPE(),   abbr => 'pqipqi' },
 505     { from => PURCHASE_QUOTATION_INTAKE_TYPE(),   to => SALES_QUOTATION_TYPE(),             abbr => 'pqisq'  },
 506     { from => PURCHASE_QUOTATION_INTAKE_TYPE(),   to => SALES_ORDER_TYPE(),                 abbr => 'pqiso'  },
 507     { from => PURCHASE_QUOTATION_INTAKE_TYPE(),   to => PURCHASE_ORDER_TYPE(),              abbr => 'pqipo'  },
 508     { from => REQUEST_QUOTATION_TYPE(),           to => PURCHASE_QUOTATION_INTAKE_TYPE(),   abbr => 'rqpqi'  },
 509     { from => PURCHASE_ORDER_CONFIRMATION_TYPE(), to => PURCHASE_ORDER_CONFIRMATION_TYPE(), abbr => 'pocpoc' },
 510     { from => PURCHASE_ORDER_CONFIRMATION_TYPE(), to => SALES_QUOTATION_TYPE(),             abbr => 'pocsq' },
 511     { from => PURCHASE_ORDER_CONFIRMATION_TYPE(), to => SALES_ORDER_TYPE(),                 abbr => 'pocso' },
 512     { from => PURCHASE_ORDER_CONFIRMATION_TYPE(), to => PURCHASE_ORDER_TYPE(),              abbr => 'pocpo' },
 513     { from => PURCHASE_ORDER_TYPE(),              to => PURCHASE_ORDER_CONFIRMATION_TYPE(), abbr => 'popoc' },
 514   );
 515   my $from_to = (grep { $_->{from} eq $source->record_type && $_->{to} eq $destination_type} @from_tos)[0];
 516   croak("Cannot convert from '" . $source->record_type . "' to '" . $destination_type . "'") if !$from_to;
 517
 518   my $is_abbr_any = sub {
 519     my (@abbrs) = @_;
 520
 521     my $missing_abbr;
 522     if (any { $missing_abbr = $_; !grep { $_->{abbr} eq $missing_abbr } @from_tos } @abbrs) {
 523       die "no such workflow abbreviation '$missing_abbr'";
 524     }
 525
 526     any { $from_to->{abbr} eq $_ } @abbrs;
 527   };
 528
 529   my %args;
 530   if (ref($source) eq 'SL::DB::Order') {
 531     %args = ( map({ ( $_ => $source->$_ ) } qw(amount cp_id currency_id cusordnumber customer_id delivery_customer_id delivery_term_id delivery_vendor_id
 532                                                department_id exchangerate globalproject_id intnotes marge_percent marge_total language_id netamount notes
 533                                                ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded tax_point taxzone_id
 534                                                transaction_description vendor_id billing_address_id
 535                                             )),
 536                  closed    => 0,
 537                  delivered => 0,
 538                  transdate => DateTime->today_local,
 539                  employee  => SL::DB::Manager::Employee->current,
 540               );
 541     # reqdate in quotation is 'offer is valid    until reqdate'
 542     # reqdate in order     is 'will be delivered until reqdate'
 543     # both dates are setable (on|off)
 544     # and may have a additional interval in days (+ n days)
 545     # dies if this convention will change
 546     $args{reqdate} = $from_to->{to} =~ m/_quotation$/
 547                    ? $::instance_conf->get_reqdate_on
 548                    ? DateTime->today_local->next_workday(extra_days => $::instance_conf->get_reqdate_interval)->to_kivitendo
 549                    : undef
 550                    : $from_to->{to} =~ m/_order$/
 551                    ? $::instance_conf->get_deliverydate_on
 552                    ? DateTime->today_local->next_workday(extra_days => $::instance_conf->get_delivery_date_interval)->to_kivitendo
 553                    : undef
 554                    : $from_to->{to} =~ m/^sales_order_intake$/
 555                    # ? $source->reqdate
 556                    ? undef
 557                    : $from_to->{to} =~ m/^purchase_quotation_intake$/
 558                    ? $source->reqdate
 559                    : $from_to->{to} =~ m/^purchase_order_confirmation$/
 560                    ? $source->reqdate
 561                    : die "Wrong state for reqdate";
 562   } elsif ( ref($source) eq 'SL::DB::Reclamation') {
 563     %args = ( map({ ( $_ => $source->$_ ) } qw(
 564         amount billing_address_id currency_id customer_id delivery_term_id department_id
 565         exchangerate globalproject_id intnotes language_id netamount
 566         notes payment_id  reqdate salesman_id shippingpoint shipvia taxincluded
 567         tax_point taxzone_id transaction_description vendor_id
 568       )),
 569       cp_id     => $source->{contact_id},
 570       closed    => 0,
 571       delivered => 0,
 572       transdate => DateTime->today_local,
 573       employee  => SL::DB::Manager::Employee->current,
 574    );
 575   }
 576
 577   if ( $is_abbr_any->(qw(soipo sopo poso rqso soisq sosq porq rqsq sqrq soirq sorq pqisq pqiso pocsq pocso)) ) {
 578     $args{ordnumber} = undef;
 579     $args{quonumber} = undef;
 580   }
 581   if ( $is_abbr_any->(qw(soipo sopo sqrq soirq sorq)) ) {
 582     $args{customer_id}      = undef;
 583     $args{salesman_id}      = undef;
 584     $args{payment_id}       = undef;
 585     $args{delivery_term_id} = undef;
 586   }
 587   if ( $is_abbr_any->(qw(poso rqsq pqisq pqiso pocsq pocso)) ) {
 588     $args{vendor_id} = undef;
 589   }
 590   if ( $is_abbr_any->(qw(soso)) ) {
 591     if ($source->periodic_invoices_config) {
 592       $args{periodic_invoices_config} = $source->periodic_invoices_config->clone_and_reset;
 593
 594       if ($args{periodic_invoices_config}->active == 1) {
 595         $args{periodic_invoices_config}->active(0);
 596         flash_later('info', $::locale->text('Periodic invoices config set to inactive.'));
 597       }
 598     }
 599   }
 600   if ( $is_abbr_any->(qw(sqrq soirq sorq)) ) {
 601     $args{cusordnumber} = undef;
 602   }
 603   if ( $is_abbr_any->(qw(soiso pocpoc pocpo popoc)) ) {
 604     $args{ordnumber} = undef;
 605   }
 606   if ( $is_abbr_any->(qw(rqpqi pqisq)) ) {
 607     $args{quonumber} = undef;
 608   }
 609
 610   # Custom shipto addresses (the ones specific to the sales/purchase
 611   # record and not to the customer/vendor) are only linked from
 612   # shipto → order. Meaning order.shipto_id
 613   # will not be filled in that case.
 614   if (!$source->shipto_id && $source->id) {
 615     $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
 616
 617   } else {
 618     $args{shipto_id} = $source->shipto_id;
 619   }
 620
 621   $args{record_type} = $destination_type;
 622
 623   my $order = $class->new(%args);
 624   $order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
 625   my $items = delete($params{items}) || $source->items_sorted;
 626
 627   my @items = map {
 628     my $source_item      = $_;
 629     my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
 630
 631     my $current_oe_item;
 632     if (ref($source) eq 'SL::DB::Order') {
 633       $current_oe_item = SL::DB::OrderItem->new(map({ ( $_ => $source_item->$_ ) }
 634                                                        qw(active_discount_source active_price_source base_qty cusordnumber
 635                                                           description discount lastcost longdescription
 636                                                           marge_percent marge_price_factor marge_total
 637                                                           ordnumber parts_id price_factor price_factor_id pricegroup_id
 638                                                           project_id qty reqdate sellprice serialnumber ship subtotal transdate unit
 639                                                           optional recurring_billing_mode position
 640                                                        )),
 641                                                    custom_variables => \@custom_variables,
 642       );
 643     } elsif (ref($source) eq 'SL::DB::Reclamation') {
 644       $current_oe_item = SL::DB::OrderItem->new(
 645         map({ ( $_ => $source_item->$_ ) } qw(
 646           active_discount_source active_price_source base_qty description
 647           discount lastcost longdescription parts_id price_factor
 648           price_factor_id pricegroup_id project_id qty reqdate sellprice
 649           serialnumber unit position
 650         )),
 651         custom_variables => \@custom_variables,
 652       );
 653     }
 654     if ( $is_abbr_any->(qw(soipo sopo)) ) {
 655       $current_oe_item->sellprice($source_item->lastcost);
 656       $current_oe_item->discount(0);
 657     }
 658     if ( $is_abbr_any->(qw(poso rqsq rqso pqisq pqiso pocsq pocso)) ) {
 659       $current_oe_item->lastcost($source_item->sellprice);
 660     }
 661     unless ($params{no_linked_records}) {
 662       $current_oe_item->{ RECORD_ITEM_ID() } = $source_item->{id};
 663       $current_oe_item->{ RECORD_ITEM_TYPE_REF() } = ref($source_item);
 664     }
 665     $current_oe_item;
 666   } @{ $items };
 667
 668   @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
 669   @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
 670   @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
 671
 672   $order->items(\@items);
 673
 674   unless ($params{no_linked_records}) {
 675     $order->{ RECORD_ID()       } = $source->{id};
 676     $order->{ RECORD_TYPE_REF() } = ref($source);
 677   }
 678
 679   return $order;
 680 }
 681
 682 sub new_from_multi {
 683   my ($class, $sources, %params) = @_;
 684
 685   croak("Unsupported object type in sources")                             if any { ref($_) !~ m{SL::DB::Order} }                   @$sources;
 686   croak("Cannot create order for purchase records")                       if any { !$_->is_sales }                                 @$sources;
 687   croak("Cannot create order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
 688
 689   # bb: todo: check shipto: is it enough to check the ids or do we have to compare the entries?
 690   if (delete $params{check_same_shipto}) {
 691     die "check same shipto address is not implemented yet";
 692     die "Source records do not have the same shipto"        if 1;
 693   }
 694
 695   # sort sources
 696   if (defined $params{sort_sources_by}) {
 697     my $sort_by = delete $params{sort_sources_by};
 698     if ($sources->[0]->can($sort_by)) {
 699       $sources = [ sort { $a->$sort_by cmp $b->$sort_by } @$sources ];
 700     } else {
 701       die "Cannot sort source records by $sort_by";
 702     }
 703   }
 704
 705   # set this entries to undef that yield different information
 706   my %attributes;
 707   foreach my $attr (qw(ordnumber transdate reqdate tax_point taxincluded shippingpoint
 708                        shipvia notes closed delivered reqdate quonumber
 709                        cusordnumber proforma transaction_description
 710                        order_probability expected_billing_date)) {
 711     $attributes{$attr} = undef if any { ($sources->[0]->$attr//'') ne ($_->$attr//'') } @$sources;
 712   }
 713   foreach my $attr (qw(cp_id currency_id salesman_id department_id
 714                        delivery_customer_id delivery_vendor_id shipto_id
 715                        globalproject_id exchangerate)) {
 716     $attributes{$attr} = undef if any { ($sources->[0]->$attr||0) != ($_->$attr||0) }   @$sources;
 717   }
 718
 719   # set this entries from customer that yield different information
 720   foreach my $attr (qw(language_id taxzone_id payment_id delivery_term_id)) {
 721     $attributes{$attr}  = $sources->[0]->customervendor->$attr if any { ($sources->[0]->$attr||0)     != ($_->$attr||0) }      @$sources;
 722   }
 723   $attributes{intnotes} = $sources->[0]->customervendor->notes if any { ($sources->[0]->intnotes//'') ne ($_->intnotes//'')  } @$sources;
 724
 725   # no periodic invoice config for new order
 726   $attributes{periodic_invoices_config} = undef;
 727
 728   # set emplyee to the current one
 729   $attributes{employee} = SL::DB::Manager::Employee->current;
 730
 731   # copy global ordnumber, transdate, cusordnumber into item scope
 732   #   unless already present there
 733   foreach my $attr (qw(ordnumber transdate cusordnumber)) {
 734     foreach my $src (@$sources) {
 735       foreach my $item (@{ $src->items_sorted }) {
 736         $item->$attr($src->$attr) if !$item->$attr;
 737       }
 738     }
 739   }
 740
 741   # collect items
 742   my @items;
 743   push @items, @{$_->items_sorted} for @$sources;
 744   # make order from first source and all items
 745   my $order = $class->new_from($sources->[0],
 746                                destination_type => SALES_ORDER_TYPE(),
 747                                attributes       => \%attributes,
 748                                items            => \@items,
 749                                %params);
 750   $order->{RECORD_ID()} = join ' ', map { $_->id } @$sources; # link all sources
 751
 752   return $order;
 753 }
 754
 755 sub number {
 756   my $self = shift;
 757
 758   my $nr_key = $self->type_data->properties('nr_key');
 759   return $self->$nr_key(@_);
 760 }
 761
 762 sub customervendor {
 763   $_[0]->type_data->properties('is_customer') ? $_[0]->customer : $_[0]->vendor;
 764 }
 765
 766 sub date {
 767   goto &transdate;
 768 }
 769
 770 sub digest {
 771   my ($self) = @_;
 772
 773   sprintf "%s %s %s (%s)",
 774     $self->number,
 775     $self->customervendor->name,
 776     $self->amount_as_number,
 777     $self->date->to_kivitendo;
 778 }
 779
 780 sub current_version_number {
 781   my ($self) = @_;
 782
 783   my $query = <<EOSQL;
 784     SELECT max(version)
 785     FROM oe_version
 786     WHERE (oe_id = ?)
 787 EOSQL
 788
 789   my ($current_version_number) = SL::DBUtils::selectfirst_array_query($::form, $self->db->dbh, $query, ($self->id));
 790   die "Invalid State. No version linked" unless $current_version_number;
 791
 792   return $current_version_number;
 793 }
 794
 795 sub is_final_version {
 796   my ($self) = @_;
 797
 798   my $order_versions_count = SL::DB::Manager::OrderVersion->get_all_count(where => [ oe_id => $self->id, final_version => 0 ]);
 799   die "Invalid version state" unless $order_versions_count < 2;
 800   my $final_version = $order_versions_count == 1 ? 0 : 1;
 801
 802   return $final_version;
 803 }
 804
 805 sub increment_version_number {
 806   my ($self) = @_;
 807
 808   die t8('This sub-version is not yet finalized') if !$self->is_final_version;
 809
 810   my $current_version_number = $self->current_version_number;
 811   my $new_version_number     = $current_version_number + 1;
 812
 813   my $new_number = $self->number;
 814   $new_number    =~ s/-$current_version_number$//;
 815   $self->number($new_number . '-' . $new_version_number);
 816   $self->add_order_version(SL::DB::OrderVersion->new(version => $new_version_number));
 817 }
 818
 819 sub netamount_base_currency {
 820   my ($self) = @_;
 821
 822   return $self->netamount unless $self->forex;
 823
 824   if ( defined $self->exchangerate ) {
 825     return $self->netamount * $self->exchangerate;
 826   } else {
 827     return $self->netamount * $self->daily_exchangerate;
 828   }
 829 }
 830
 831 sub preceding_purchase_orders {
 832   my ($self) = @_;
 833
 834   my @lrs = ();
 835   if ($self->id) {
 836     @lrs = grep { $_->record_type eq PURCHASE_ORDER_TYPE() } @{$self->linked_records(from => 'SL::DB::Order')};
 837   } else {
 838     if ('SL::DB::Order' eq $self->{RECORD_TYPE_REF()}) {
 839       my $order = SL::DB::Order->load_cached($self->{RECORD_ID()});
 840       push @lrs, $order if $order->record_type eq PURCHASE_ORDER_TYPE();
 841     }
 842   }
 843
 844   return \@lrs;
 845 }
 846
 847 sub type_data {
 848   SL::DB::Helper::TypeDataProxy->new(ref $_[0], $_[0]->type);
 849 }
 850
 851 1;
 852
 853 __END__
 854
 855 =pod
 856
 857 =encoding utf8
 858
 859 =head1 NAME
 860
 861 SL::DB::Order - Order Datenbank Objekt.
 862
 863 =head1 FUNCTIONS
 864
 865 =head2 C<type>
 866
 867 Returns one of the following string types:
 868
 869 =over 4
 870
 871 =item sales_order
 872
 873 =item purchase_order
 874
 875 =item sales_quotation
 876
 877 =item request_quotation
 878
 879 =back
 880
 881 =head2 C<is_type TYPE>
 882
 883 Returns true if the order is of the given type.
 884
 885 =head2 C<daily_exchangerate $val>
 886
 887 Gets or sets the exchangerate object's value. This is the value from the
 888 table C<exchangerate> depending on the order's currency, the transdate and
 889 if it is a sales or purchase order.
 890
 891 The order object (respectively the table C<oe>) has an own column
 892 C<exchangerate> which can be get or set with the accessor C<exchangerate>.
 893
 894 The idea is to drop the legacy table C<exchangerate> in the future and to
 895 give all relevant tables it's own C<exchangerate> column.
 896
 897 So, this method is here if you need to access the "legacy" exchangerate via
 898 an order object.
 899
 900 =over 4
 901
 902 =item C<$val>
 903
 904 (optional) If given, the exchangerate in the "legacy" table is set to this
 905 value, depending on currency, transdate and sales or purchase.
 906
 907 =back
 908
 909 =head2 C<convert_to_delivery_order %params>
 910
 911 Creates a new delivery order with C<$self> as the basis by calling
 912 L<SL::DB::DeliveryOrder::new_from>. That delivery order is saved, and
 913 C<$self> is linked to the new invoice via
 914 L<SL::DB::RecordLink>. C<$self>'s C<delivered> attribute is set to
 915 C<true>, and C<$self> is saved.
 916
 917 The arguments in C<%params> are passed to
 918 L<SL::DB::DeliveryOrder::new_from>.
 919
 920 Returns C<undef> on failure. Otherwise the new delivery order will be
 921 returned.
 922
 923 =head2 C<convert_to_invoice %params>
 924
 925 Creates a new invoice with C<$self> as the basis by calling
 926 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
 927 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
 928 C<closed> attribute is set to C<true>, and C<$self> is saved.
 929
 930 The arguments in C<%params> are passed to L<SL::DB::Invoice::new_from>.
 931
 932 Returns the new invoice instance on success and C<undef> on
 933 failure. The whole process is run inside a transaction. On failure
 934 nothing is created or changed in the database.
 935
 936 At the moment only sales quotations and sales orders can be converted.
 937
 938 =head2 C<new_from $source, %params>
 939
 940 Creates a new C<SL::DB::Order> instance and copies as much
 941 information from C<$source> as possible. At the moment only records with the
 942 same destination type as the source type and sales orders from
 943 sales quotations and purchase orders from requests for quotations can be
 944 created.
 945
 946 The C<transdate> field will be set to the current date.
 947
 948 The conversion copies the order items as well.
 949
 950 Returns the new order instance. The object returned is not
 951 saved.
 952
 953 C<%params> can include the following options
 954 (C<destination_type> is mandatory):
 955
 956 =over 4
 957
 958 =item C<destination_type>
 959
 960 (mandatory)
 961 The type of the newly created object. Can be C<sales_quotation>,
 962 C<sales_order>, C<purchase_quotation> or C<purchase_order> for now.
 963
 964 =item C<items>
 965
 966 An optional array reference of RDBO instances for the items to use. If
 967 missing then the method C<items_sorted> will be called on
 968 C<$source>. This option can be used to override the sorting, to
 969 exclude certain positions or to add additional ones.
 970
 971 =item C<skip_items_negative_qty>
 972
 973 If trueish then items with a negative quantity are skipped. Items with
 974 a quantity of 0 are not affected by this option.
 975
 976 =item C<skip_items_zero_qty>
 977
 978 If trueish then items with a quantity of 0 are skipped.
 979
 980 =item C<item_filter>
 981
 982 An optional code reference that is called for each item with the item
 983 as its sole parameter. Items for which the code reference returns a
 984 falsish value will be skipped.
 985
 986 =item C<attributes>
 987
 988 An optional hash reference. If it exists then it is passed to C<new>
 989 allowing the caller to set certain attributes for the new delivery
 990 order.
 991
 992 =back
 993
 994 =head2 C<new_from_multi $sources, %params>
 995
 996 Creates a new C<SL::DB::Order> instance from multiple sources and copies as
 997 much information from C<$sources> as possible.
 998 At the moment only sales orders can be combined and they must be of the same
 999 customer.
1000
1001 The new order is created from the first one using C<new_from> and the positions
1002 of all orders are added to the new order. The orders can be sorted with the
1003 parameter C<sort_sources_by>.
1004
1005 The orders attributes are kept if they contain the same information for all
1006 source orders an will be set to empty if they contain different information.
1007
1008 Returns the new order instance. The object returned is not
1009 saved.
1010
1011 C<params> other then C<sort_sources_by> are passed to C<new_from>.
1012
1013 =head2 C<increment_version_number>
1014
1015 Checks if the current version of the order is finalized, increments
1016 the version number and adds a new order_version to the order.
1017 Dies if the version is not final.
1018
1019 =head1 BUGS
1020
1021 Nothing here yet.
1022
1023 =head1 AUTHOR
1024
1025 Sven Schöling <s.schoeling@linet-services.de>
1026
1027 =cut