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 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,
339 employee => SL::DB::Manager::Employee->current,
342 if ( $is_abbr_any->(qw(sopo poso)) ) {
343 $args{ordnumber} = undef;
344 $args{quonumber} = undef;
345 $args{reqdate} = DateTime->today_local->next_workday();
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 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 # set emplyee to the current one
467 $attributes{employee} = SL::DB::Manager::Employee->current;
469 # copy global ordnumber, transdate, cusordnumber into item scope
470 # unless already present there
471 foreach my $attr (qw(ordnumber transdate cusordnumber)) {
472 foreach my $src (@$sources) {
473 foreach my $item (@{ $src->items_sorted }) {
474 $item->$attr($src->$attr) if !$item->$attr;
481 push @items, @{$_->items_sorted} for @$sources;
482 # make order from first source and all items
483 my $order = $class->new_from($sources->[0],
484 destination_type => 'sales_order',
485 attributes => \%attributes,
495 return if !$self->type;
497 my %number_method = (
498 sales_order => 'ordnumber',
499 sales_quotation => 'quonumber',
500 purchase_order => 'ordnumber',
501 request_quotation => 'quonumber',
504 return $self->${ \ $number_method{$self->type} }(@_);
508 $_[0]->is_sales ? $_[0]->customer : $_[0]->vendor;
518 sprintf "%s %s %s (%s)",
520 $self->customervendor->name,
521 $self->amount_as_number,
522 $self->date->to_kivitendo;
535 SL::DB::Order - Order Datenbank Objekt.
541 Returns one of the following string types:
549 =item sales_quotation
551 =item request_quotation
555 =head2 C<is_type TYPE>
557 Returns true if the order is of the given type.
559 =head2 C<daily_exchangerate $val>
561 Gets or sets the exchangerate object's value. This is the value from the
562 table C<exchangerate> depending on the order's currency, the transdate and
563 if it is a sales or purchase order.
565 The order object (respectively the table C<oe>) has an own column
566 C<exchangerate> which can be get or set with the accessor C<exchangerate>.
568 The idea is to drop the legacy table C<exchangerate> in the future and to
569 give all relevant tables it's own C<exchangerate> column.
571 So, this method is here if you need to access the "legacy" exchangerate via
578 (optional) If given, the exchangerate in the "legacy" table is set to this
579 value, depending on currency, transdate and sales or purchase.
583 =head2 C<convert_to_delivery_order %params>
585 Creates a new delivery order with C<$self> as the basis by calling
586 L<SL::DB::DeliveryOrder::new_from>. That delivery order is saved, and
587 C<$self> is linked to the new invoice via
588 L<SL::DB::RecordLink>. C<$self>'s C<delivered> attribute is set to
589 C<true>, and C<$self> is saved.
591 The arguments in C<%params> are passed to
592 L<SL::DB::DeliveryOrder::new_from>.
594 Returns C<undef> on failure. Otherwise the new delivery order will be
597 =head2 C<convert_to_invoice %params>
599 Creates a new invoice with C<$self> as the basis by calling
600 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
601 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
602 C<closed> attribute is set to C<true>, and C<$self> is saved.
604 The arguments in C<%params> are passed to L<SL::DB::Invoice::post>.
606 Returns the new invoice instance on success and C<undef> on
607 failure. The whole process is run inside a transaction. On failure
608 nothing is created or changed in the database.
610 At the moment only sales quotations and sales orders can be converted.
612 =head2 C<new_from $source, %params>
614 Creates a new C<SL::DB::Order> instance and copies as much
615 information from C<$source> as possible. At the moment only records with the
616 same destination type as the source type and sales orders from
617 sales quotations and purchase orders from requests for quotations can be
620 The C<transdate> field will be set to the current date.
622 The conversion copies the order items as well.
624 Returns the new order instance. The object returned is not
627 C<%params> can include the following options
628 (C<destination_type> is mandatory):
632 =item C<destination_type>
635 The type of the newly created object. Can be C<sales_quotation>,
636 C<sales_order>, C<purchase_quotation> or C<purchase_order> for now.
640 An optional array reference of RDBO instances for the items to use. If
641 missing then the method C<items_sorted> will be called on
642 C<$source>. This option can be used to override the sorting, to
643 exclude certain positions or to add additional ones.
645 =item C<skip_items_negative_qty>
647 If trueish then items with a negative quantity are skipped. Items with
648 a quantity of 0 are not affected by this option.
650 =item C<skip_items_zero_qty>
652 If trueish then items with a quantity of 0 are skipped.
656 An optional code reference that is called for each item with the item
657 as its sole parameter. Items for which the code reference returns a
658 falsish value will be skipped.
662 An optional hash reference. If it exists then it is passed to C<new>
663 allowing the caller to set certain attributes for the new delivery
668 =head2 C<new_from_multi $sources, %params>
670 Creates a new C<SL::DB::Order> instance from multiple sources and copies as
671 much information from C<$sources> as possible.
672 At the moment only sales orders can be combined and they must be of the same
675 The new order is created from the first one using C<new_from> and the positions
676 of all orders are added to the new order. The orders can be sorted with the
677 parameter C<sort_sources_by>.
679 The orders attributes are kept if they contain the same information for all
680 source orders an will be set to empty if they contain different information.
682 Returns the new order instance. The object returned is not
685 C<params> other then C<sort_sources_by> are passed to C<new_from>.
693 Sven Schöling <s.schoeling@linet-services.de>