8 use List::Util qw(max);
 
   9 use List::MoreUtils qw(any);
 
  11 use SL::DB::MetaSetup::Order;
 
  12 use SL::DB::Manager::Order;
 
  13 use SL::DB::Helper::Attr;
 
  14 use SL::DB::Helper::AttrHTML;
 
  15 use SL::DB::Helper::AttrSorted;
 
  16 use SL::DB::Helper::FlattenToForm;
 
  17 use SL::DB::Helper::LinkedRecords;
 
  18 use SL::DB::Helper::PriceTaxCalculator;
 
  19 use SL::DB::Helper::PriceUpdater;
 
  20 use SL::DB::Helper::TransNumberGenerator;
 
  21 use SL::Locale::String qw(t8);
 
  23 use Rose::DB::Object::Helpers qw(as_tree);
 
  25 __PACKAGE__->meta->add_relationship(
 
  27     type         => 'one to many',
 
  28     class        => 'SL::DB::OrderItem',
 
  29     column_map   => { id => 'trans_id' },
 
  31       with_objects => [ 'part' ]
 
  34   periodic_invoices_config => {
 
  36     class                  => 'SL::DB::PeriodicInvoicesConfig',
 
  37     column_map             => { id => 'oe_id' },
 
  41     class                  => 'SL::DB::Shipto',
 
  42     column_map             => { id => 'trans_id' },
 
  43     query_args             => [ module => 'OE' ],
 
  47     class                  => 'SL::DB::Exchangerate',
 
  48     column_map             => { currency_id => 'currency_id', transdate => 'transdate' },
 
  52 SL::DB::Helper::Attr::make(__PACKAGE__, daily_exchangerate => 'numeric');
 
  54 __PACKAGE__->meta->initialize;
 
  56 __PACKAGE__->attr_html('notes');
 
  57 __PACKAGE__->attr_sorted('items');
 
  59 __PACKAGE__->before_save('_before_save_set_ord_quo_number');
 
  60 __PACKAGE__->before_save('_before_save_create_new_project');
 
  61 __PACKAGE__->before_save('_before_save_remove_empty_custom_shipto');
 
  62 __PACKAGE__->before_save('_before_save_set_custom_shipto_module');
 
  66 sub _before_save_set_ord_quo_number {
 
  69   # ordnumber is 'NOT NULL'. Therefore make sure it's always set to at
 
  70   # least an empty string, even if we're saving a quotation.
 
  71   $self->ordnumber('') if !$self->ordnumber;
 
  73   my $field = $self->quotation ? 'quonumber' : 'ordnumber';
 
  74   $self->create_trans_number if !$self->$field;
 
  78 sub _before_save_create_new_project {
 
  81   # force new project, if not set yet
 
  82   if ($::instance_conf->get_order_always_project && !$self->globalproject_id && ($self->type eq 'sales_order')) {
 
  84     die t8("Error while creating project with project number of new order number, project number #1 already exists!", $self->ordnumber)
 
  85       if SL::DB::Manager::Project->find_by(projectnumber => $self->ordnumber);
 
  88       my $new_project = SL::DB::Project->new(
 
  89           projectnumber     => $self->ordnumber,
 
  90           description       => $self->customer->name,
 
  91           customer_id       => $self->customer->id,
 
  93           project_type_id   => $::instance_conf->get_project_type_id,
 
  94           project_status_id => $::instance_conf->get_project_status_id,
 
  97        $self->globalproject_id($new_project->id);
 
  98     } or die t8('Could not create new project #1', $@);
 
 104 sub _before_save_remove_empty_custom_shipto {
 
 107   $self->custom_shipto(undef) if $self->custom_shipto && $self->custom_shipto->is_empty;
 
 112 sub _before_save_set_custom_shipto_module {
 
 115   $self->custom_shipto->module('OE') if $self->custom_shipto;
 
 122 sub items { goto &orderitems; }
 
 123 sub add_items { goto &add_orderitems; }
 
 124 sub record_number { goto &number; }
 
 129   return 'sales_order'       if $self->customer_id && ! $self->quotation;
 
 130   return 'purchase_order'    if $self->vendor_id   && ! $self->quotation;
 
 131   return 'sales_quotation'   if $self->customer_id &&   $self->quotation;
 
 132   return 'request_quotation' if $self->vendor_id   &&   $self->quotation;
 
 138   return shift->type eq shift;
 
 142   # oe doesn't have deliverydate, but it does have reqdate.
 
 143   # But this has a different meaning for sales quotations.
 
 144   # deliverydate can be used to determine tax if tax_point isn't set.
 
 146   return $_[0]->reqdate if $_[0]->type ne 'sales_quotation';
 
 149 sub effective_tax_point {
 
 152   return $self->tax_point || $self->deliverydate || $self->transdate;
 
 155 sub displayable_type {
 
 156   my $type = shift->type;
 
 158   return $::locale->text('Sales quotation')   if $type eq 'sales_quotation';
 
 159   return $::locale->text('Request quotation') if $type eq 'request_quotation';
 
 160   return $::locale->text('Sales Order')       if $type eq 'sales_order';
 
 161   return $::locale->text('Purchase Order')    if $type eq 'purchase_order';
 
 166 sub displayable_name {
 
 167   join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
 
 171   croak 'not an accessor' if @_ > 1;
 
 172   return !!shift->customer_id;
 
 175 sub daily_exchangerate {
 
 176   my ($self, $val) = @_;
 
 178   return 1 if $self->currency_id == $::instance_conf->get_currency_id;
 
 180   my $rate = (any { $self->is_type($_) } qw(sales_quotation sales_order))      ? 'buy'
 
 181            : (any { $self->is_type($_) } qw(request_quotation purchase_order)) ? 'sell'
 
 186     croak t8('exchange rate has to be positive') if $val <= 0;
 
 187     if (!$self->exchangerate_obj) {
 
 188       $self->exchangerate_obj(SL::DB::Exchangerate->new(
 
 189         currency_id => $self->currency_id,
 
 190         transdate   => $self->transdate,
 
 193     } elsif (!defined $self->exchangerate_obj->$rate) {
 
 194       $self->exchangerate_obj->$rate($val);
 
 196       croak t8('exchange rate already exists, no update allowed');
 
 199   return $self->exchangerate_obj->$rate if $self->exchangerate_obj;
 
 206   if ($self->quotation) {
 
 209     require SL::DB::Invoice;
 
 210     return SL::DB::Manager::Invoice->get_all(
 
 212         ordnumber => $self->ordnumber,
 
 213         @{ $params{query} || [] },
 
 219 sub displayable_state {
 
 222   return $self->closed ? $::locale->text('closed') : $::locale->text('open');
 
 225 sub abschlag_invoices {
 
 226   return shift()->invoices(query => [ abschlag => 1 ]);
 
 230   return shift()->invoices(query => [ abschlag => 0 ]);
 
 233 sub convert_to_invoice {
 
 234   my ($self, %params) = @_;
 
 236   croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
 
 239   if (!$self->db->with_transaction(sub {
 
 240     require SL::DB::Invoice;
 
 241     $invoice = SL::DB::Invoice->new_from($self)->post(%params) || die;
 
 242     $self->link_to_record($invoice);
 
 243     $self->update_attributes(closed => 1);
 
 252 sub convert_to_delivery_order {
 
 253   my ($self, @args) = @_;
 
 256   if (!$self->db->with_transaction(sub {
 
 257     require SL::DB::DeliveryOrder;
 
 258     $delivery_order = SL::DB::DeliveryOrder->new_from($self, @args);
 
 259     $delivery_order->save;
 
 260     $self->link_to_record($delivery_order);
 
 261     # TODO extend link_to_record for items, otherwise long-term no d.r.y.
 
 262     foreach my $item (@{ $delivery_order->items }) {
 
 263       foreach (qw(orderitems)) {    # expand if needed (delivery_order_items)
 
 264         if ($item->{"converted_from_${_}_id"}) {
 
 265           die unless $item->{id};
 
 266           RecordLinks->create_links('dbh'        => $self->db->dbh,
 
 269                                     'from_ids'   => $item->{"converted_from_${_}_id"},
 
 270                                     'to_table'   => 'delivery_order_items',
 
 271                                     'to_id'      => $item->{id},
 
 273           delete $item->{"converted_from_${_}_id"};
 
 278     $self->update_attributes(delivered => 1) unless $::instance_conf->get_shipped_qty_require_stock_out;
 
 284   return $delivery_order;
 
 287 sub _clone_orderitem_cvar {
 
 290   my $cloned = $_->clone_and_reset;
 
 291   $cloned->sub_module('orderitems');
 
 297   my ($class, $source, %params) = @_;
 
 299   croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
 
 300   croak("A destination type must be given as parameter")         unless $params{destination_type};
 
 302   my $destination_type  = delete $params{destination_type};
 
 305     { from => 'sales_quotation',   to => 'sales_order',       abbr => 'sqso' },
 
 306     { from => 'request_quotation', to => 'purchase_order',    abbr => 'rqpo' },
 
 307     { from => 'sales_quotation',   to => 'sales_quotation',   abbr => 'sqsq' },
 
 308     { from => 'sales_order',       to => 'sales_order',       abbr => 'soso' },
 
 309     { from => 'request_quotation', to => 'request_quotation', abbr => 'rqrq' },
 
 310     { from => 'purchase_order',    to => 'purchase_order',    abbr => 'popo' },
 
 311     { from => 'sales_order',       to => 'purchase_order',    abbr => 'sopo' },
 
 312     { from => 'purchase_order',    to => 'sales_order',       abbr => 'poso' },
 
 313     { from => 'sales_order',       to => 'sales_quotation',   abbr => 'sosq' },
 
 314     { from => 'purchase_order',    to => 'request_quotation', abbr => 'porq' },
 
 316   my $from_to = (grep { $_->{from} eq $source->type && $_->{to} eq $destination_type} @from_tos)[0];
 
 317   croak("Cannot convert from '" . $source->type . "' to '" . $destination_type . "'") if !$from_to;
 
 319   my $is_abbr_any = sub {
 
 320     any { $from_to->{abbr} eq $_ } @_;
 
 323   my ($item_parent_id_column, $item_parent_column);
 
 325   if (ref($source) eq 'SL::DB::Order') {
 
 326     $item_parent_id_column = 'trans_id';
 
 327     $item_parent_column    = 'order';
 
 330   my %args = ( map({ ( $_ => $source->$_ ) } qw(amount cp_id currency_id cusordnumber customer_id delivery_customer_id delivery_term_id delivery_vendor_id
 
 331                                                 department_id employee_id exchangerate globalproject_id intnotes marge_percent marge_total language_id netamount notes
 
 332                                                 ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded tax_point taxzone_id
 
 333                                                 transaction_description vendor_id
 
 335                quotation => !!($destination_type =~ m{quotation$}),
 
 338                transdate => DateTime->today_local,
 
 341   if ( $is_abbr_any->(qw(sopo poso)) ) {
 
 342     $args{ordnumber} = undef;
 
 343     $args{quonumber} = undef;
 
 344     $args{reqdate}   = DateTime->today_local->next_workday();
 
 345     $args{employee}  = SL::DB::Manager::Employee->current;
 
 347   if ( $is_abbr_any->(qw(sopo)) ) {
 
 348     $args{customer_id}      = undef;
 
 349     $args{salesman_id}      = undef;
 
 350     $args{payment_id}       = undef;
 
 351     $args{delivery_term_id} = undef;
 
 353   if ( $is_abbr_any->(qw(poso)) ) {
 
 354     $args{vendor_id} = undef;
 
 356   if ( $is_abbr_any->(qw(soso)) ) {
 
 357     $args{periodic_invoices_config} = $source->periodic_invoices_config->clone_and_reset if $source->periodic_invoices_config;
 
 359   if ( $is_abbr_any->(qw(sosq porq)) ) {
 
 360     $args{ordnumber} = undef;
 
 361     $args{quonumber} = undef;
 
 362     $args{reqdate}   = DateTime->today_local->next_workday();
 
 365   # Custom shipto addresses (the ones specific to the sales/purchase
 
 366   # record and not to the customer/vendor) are only linked from
 
 367   # shipto â†’ order. Meaning order.shipto_id
 
 368   # will not be filled in that case.
 
 369   if (!$source->shipto_id && $source->id) {
 
 370     $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
 
 373     $args{shipto_id} = $source->shipto_id;
 
 376   my $order = $class->new(%args);
 
 377   $order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
 
 378   my $items = delete($params{items}) || $source->items_sorted;
 
 383     my $source_item      = $_;
 
 384     my $source_item_id   = $_->$item_parent_id_column;
 
 385     my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
 
 387     $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
 
 388     my $item_parent                  = $item_parents{$source_item_id};
 
 390     my $current_oe_item = SL::DB::OrderItem->new(map({ ( $_ => $source_item->$_ ) }
 
 391                                                      qw(active_discount_source active_price_source base_qty cusordnumber
 
 392                                                         description discount lastcost longdescription
 
 393                                                         marge_percent marge_price_factor marge_total
 
 394                                                         ordnumber parts_id price_factor price_factor_id pricegroup_id
 
 395                                                         project_id qty reqdate sellprice serialnumber ship subtotal transdate unit
 
 398                                                  custom_variables => \@custom_variables,
 
 400     if ( $is_abbr_any->(qw(sopo)) ) {
 
 401       $current_oe_item->sellprice($source_item->lastcost);
 
 402       $current_oe_item->discount(0);
 
 404     if ( $is_abbr_any->(qw(poso)) ) {
 
 405       $current_oe_item->lastcost($source_item->sellprice);
 
 407     $current_oe_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
 
 411   @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
 
 412   @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
 
 413   @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
 
 415   $order->items(\@items);
 
 421   my ($class, $sources, %params) = @_;
 
 423   croak("Unsupported object type in sources")                             if any { ref($_) !~ m{SL::DB::Order} }                   @$sources;
 
 424   croak("Cannot create order for purchase records")                       if any { !$_->is_sales }                                 @$sources;
 
 425   croak("Cannot create order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
 
 427   # bb: todo: check shipto: is it enough to check the ids or do we have to compare the entries?
 
 428   if (delete $params{check_same_shipto}) {
 
 429     die "check same shipto address is not implemented yet";
 
 430     die "Source records do not have the same shipto"        if 1;
 
 434   if (defined $params{sort_sources_by}) {
 
 435     my $sort_by = delete $params{sort_sources_by};
 
 436     if ($sources->[0]->can($sort_by)) {
 
 437       $sources = [ sort { $a->$sort_by cmp $b->$sort_by } @$sources ];
 
 439       die "Cannot sort source records by $sort_by";
 
 443   # set this entries to undef that yield different information
 
 445   foreach my $attr (qw(ordnumber transdate reqdate tax_point taxincluded shippingpoint
 
 446                        shipvia notes closed delivered reqdate quonumber
 
 447                        cusordnumber proforma transaction_description
 
 448                        order_probability expected_billing_date)) {
 
 449     $attributes{$attr} = undef if any { ($sources->[0]->$attr//'') ne ($_->$attr//'') } @$sources;
 
 451   foreach my $attr (qw(cp_id currency_id employee_id salesman_id department_id
 
 452                        delivery_customer_id delivery_vendor_id shipto_id
 
 453                        globalproject_id exchangerate)) {
 
 454     $attributes{$attr} = undef if any { ($sources->[0]->$attr||0) != ($_->$attr||0) }   @$sources;
 
 457   # set this entries from customer that yield different information
 
 458   foreach my $attr (qw(language_id taxzone_id payment_id delivery_term_id)) {
 
 459     $attributes{$attr}  = $sources->[0]->customervendor->$attr if any { ($sources->[0]->$attr||0)     != ($_->$attr||0) }      @$sources;
 
 461   $attributes{intnotes} = $sources->[0]->customervendor->notes if any { ($sources->[0]->intnotes//'') ne ($_->intnotes//'')  } @$sources;
 
 463   # no periodic invoice config for new order
 
 464   $attributes{periodic_invoices_config} = undef;
 
 466   # copy global ordnumber, transdate, cusordnumber into item scope
 
 467   #   unless already present there
 
 468   foreach my $attr (qw(ordnumber transdate cusordnumber)) {
 
 469     foreach my $src (@$sources) {
 
 470       foreach my $item (@{ $src->items_sorted }) {
 
 471         $item->$attr($src->$attr) if !$item->$attr;
 
 478   push @items, @{$_->items_sorted} for @$sources;
 
 479   # make order from first source and all items
 
 480   my $order = $class->new_from($sources->[0],
 
 481                                destination_type => 'sales_order',
 
 482                                attributes       => \%attributes,
 
 492   return if !$self->type;
 
 494   my %number_method = (
 
 495     sales_order       => 'ordnumber',
 
 496     sales_quotation   => 'quonumber',
 
 497     purchase_order    => 'ordnumber',
 
 498     request_quotation => 'quonumber',
 
 501   return $self->${ \ $number_method{$self->type} }(@_);
 
 505   $_[0]->is_sales ? $_[0]->customer : $_[0]->vendor;
 
 515   sprintf "%s %s %s (%s)",
 
 517     $self->customervendor->name,
 
 518     $self->amount_as_number,
 
 519     $self->date->to_kivitendo;
 
 532 SL::DB::Order - Order Datenbank Objekt.
 
 538 Returns one of the following string types:
 
 546 =item sales_quotation
 
 548 =item request_quotation
 
 552 =head2 C<is_type TYPE>
 
 554 Returns true if the order is of the given type.
 
 556 =head2 C<daily_exchangerate $val>
 
 558 Gets or sets the exchangerate object's value. This is the value from the
 
 559 table C<exchangerate> depending on the order's currency, the transdate and
 
 560 if it is a sales or purchase order.
 
 562 The order object (respectively the table C<oe>) has an own column
 
 563 C<exchangerate> which can be get or set with the accessor C<exchangerate>.
 
 565 The idea is to drop the legacy table C<exchangerate> in the future and to
 
 566 give all relevant tables it's own C<exchangerate> column.
 
 568 So, this method is here if you need to access the "legacy" exchangerate via
 
 575 (optional) If given, the exchangerate in the "legacy" table is set to this
 
 576 value, depending on currency, transdate and sales or purchase.
 
 580 =head2 C<convert_to_delivery_order %params>
 
 582 Creates a new delivery order with C<$self> as the basis by calling
 
 583 L<SL::DB::DeliveryOrder::new_from>. That delivery order is saved, and
 
 584 C<$self> is linked to the new invoice via
 
 585 L<SL::DB::RecordLink>. C<$self>'s C<delivered> attribute is set to
 
 586 C<true>, and C<$self> is saved.
 
 588 The arguments in C<%params> are passed to
 
 589 L<SL::DB::DeliveryOrder::new_from>.
 
 591 Returns C<undef> on failure. Otherwise the new delivery order will be
 
 594 =head2 C<convert_to_invoice %params>
 
 596 Creates a new invoice with C<$self> as the basis by calling
 
 597 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
 
 598 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
 
 599 C<closed> attribute is set to C<true>, and C<$self> is saved.
 
 601 The arguments in C<%params> are passed to L<SL::DB::Invoice::post>.
 
 603 Returns the new invoice instance on success and C<undef> on
 
 604 failure. The whole process is run inside a transaction. On failure
 
 605 nothing is created or changed in the database.
 
 607 At the moment only sales quotations and sales orders can be converted.
 
 609 =head2 C<new_from $source, %params>
 
 611 Creates a new C<SL::DB::Order> instance and copies as much
 
 612 information from C<$source> as possible. At the moment only records with the
 
 613 same destination type as the source type and sales orders from
 
 614 sales quotations and purchase orders from requests for quotations can be
 
 617 The C<transdate> field will be set to the current date.
 
 619 The conversion copies the order items as well.
 
 621 Returns the new order instance. The object returned is not
 
 624 C<%params> can include the following options
 
 625 (C<destination_type> is mandatory):
 
 629 =item C<destination_type>
 
 632 The type of the newly created object. Can be C<sales_quotation>,
 
 633 C<sales_order>, C<purchase_quotation> or C<purchase_order> for now.
 
 637 An optional array reference of RDBO instances for the items to use. If
 
 638 missing then the method C<items_sorted> will be called on
 
 639 C<$source>. This option can be used to override the sorting, to
 
 640 exclude certain positions or to add additional ones.
 
 642 =item C<skip_items_negative_qty>
 
 644 If trueish then items with a negative quantity are skipped. Items with
 
 645 a quantity of 0 are not affected by this option.
 
 647 =item C<skip_items_zero_qty>
 
 649 If trueish then items with a quantity of 0 are skipped.
 
 653 An optional code reference that is called for each item with the item
 
 654 as its sole parameter. Items for which the code reference returns a
 
 655 falsish value will be skipped.
 
 659 An optional hash reference. If it exists then it is passed to C<new>
 
 660 allowing the caller to set certain attributes for the new delivery
 
 665 =head2 C<new_from_multi $sources, %params>
 
 667 Creates a new C<SL::DB::Order> instance from multiple sources and copies as
 
 668 much information from C<$sources> as possible.
 
 669 At the moment only sales orders can be combined and they must be of the same
 
 672 The new order is created from the first one using C<new_from> and the positions
 
 673 of all orders are added to the new order. The orders can be sorted with the
 
 674 parameter C<sort_sources_by>.
 
 676 The orders attributes are kept if they contain the same information for all
 
 677 source orders an will be set to empty if they contain different information.
 
 679 Returns the new order instance. The object returned is not
 
 682 C<params> other then C<sort_sources_by> are passed to C<new_from>.
 
 690 Sven Schöling <s.schoeling@linet-services.de>