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' },
51 type => 'one to many',
52 class => 'SL::DB::Note',
53 column_map => { id => 'trans_id' },
54 query_args => [ trans_module => 'oe' ],
56 with_objects => [ 'employee' ],
57 sort_by => 'notes.itime',
62 SL::DB::Helper::Attr::make(__PACKAGE__, daily_exchangerate => 'numeric');
64 __PACKAGE__->meta->initialize;
66 __PACKAGE__->attr_html('notes');
67 __PACKAGE__->attr_sorted('items');
69 __PACKAGE__->before_save('_before_save_set_ord_quo_number');
70 __PACKAGE__->before_save('_before_save_create_new_project');
71 __PACKAGE__->before_save('_before_save_remove_empty_custom_shipto');
72 __PACKAGE__->before_save('_before_save_set_custom_shipto_module');
76 sub _before_save_set_ord_quo_number {
79 # ordnumber is 'NOT NULL'. Therefore make sure it's always set to at
80 # least an empty string, even if we're saving a quotation.
81 $self->ordnumber('') if !$self->ordnumber;
83 my $field = $self->quotation ? 'quonumber' : 'ordnumber';
84 $self->create_trans_number if !$self->$field;
88 sub _before_save_create_new_project {
91 # force new project, if not set yet
92 if ($::instance_conf->get_order_always_project && !$self->globalproject_id && ($self->type eq 'sales_order')) {
94 die t8("Error while creating project with project number of new order number, project number #1 already exists!", $self->ordnumber)
95 if SL::DB::Manager::Project->find_by(projectnumber => $self->ordnumber);
98 my $new_project = SL::DB::Project->new(
99 projectnumber => $self->ordnumber,
100 description => $self->customer->name,
101 customer_id => $self->customer->id,
103 project_type_id => $::instance_conf->get_project_type_id,
104 project_status_id => $::instance_conf->get_project_status_id,
107 $self->globalproject_id($new_project->id);
108 } or die t8('Could not create new project #1', $@);
114 sub _before_save_remove_empty_custom_shipto {
117 $self->custom_shipto(undef) if $self->custom_shipto && $self->custom_shipto->is_empty;
122 sub _before_save_set_custom_shipto_module {
125 $self->custom_shipto->module('OE') if $self->custom_shipto;
132 sub items { goto &orderitems; }
133 sub add_items { goto &add_orderitems; }
134 sub record_number { goto &number; }
139 return 'sales_order' if $self->customer_id && ! $self->quotation;
140 return 'purchase_order' if $self->vendor_id && ! $self->quotation;
141 return 'sales_quotation' if $self->customer_id && $self->quotation;
142 return 'request_quotation' if $self->vendor_id && $self->quotation;
148 return shift->type eq shift;
152 # oe doesn't have deliverydate, but it does have reqdate.
153 # But this has a different meaning for sales quotations.
154 # deliverydate can be used to determine tax if tax_point isn't set.
156 return $_[0]->reqdate if $_[0]->type ne 'sales_quotation';
159 sub effective_tax_point {
162 return $self->tax_point || $self->deliverydate || $self->transdate;
165 sub displayable_type {
166 my $type = shift->type;
168 return $::locale->text('Sales quotation') if $type eq 'sales_quotation';
169 return $::locale->text('Request quotation') if $type eq 'request_quotation';
170 return $::locale->text('Sales Order') if $type eq 'sales_order';
171 return $::locale->text('Purchase Order') if $type eq 'purchase_order';
176 sub displayable_name {
177 join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
181 croak 'not an accessor' if @_ > 1;
182 return !!shift->customer_id;
185 sub daily_exchangerate {
186 my ($self, $val) = @_;
188 return 1 if $self->currency_id == $::instance_conf->get_currency_id;
190 my $rate = (any { $self->is_type($_) } qw(sales_quotation sales_order)) ? 'buy'
191 : (any { $self->is_type($_) } qw(request_quotation purchase_order)) ? 'sell'
196 croak t8('exchange rate has to be positive') if $val <= 0;
197 if (!$self->exchangerate_obj) {
198 $self->exchangerate_obj(SL::DB::Exchangerate->new(
199 currency_id => $self->currency_id,
200 transdate => $self->transdate,
203 } elsif (!defined $self->exchangerate_obj->$rate) {
204 $self->exchangerate_obj->$rate($val);
206 croak t8('exchange rate already exists, no update allowed');
209 return $self->exchangerate_obj->$rate if $self->exchangerate_obj;
216 if ($self->quotation) {
219 require SL::DB::Invoice;
220 return SL::DB::Manager::Invoice->get_all(
222 ordnumber => $self->ordnumber,
223 @{ $params{query} || [] },
229 sub displayable_state {
232 return $self->closed ? $::locale->text('closed') : $::locale->text('open');
235 sub abschlag_invoices {
236 return shift()->invoices(query => [ abschlag => 1 ]);
240 return shift()->invoices(query => [ abschlag => 0 ]);
243 sub convert_to_invoice {
244 my ($self, %params) = @_;
246 croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
249 if (!$self->db->with_transaction(sub {
250 require SL::DB::Invoice;
251 $invoice = SL::DB::Invoice->new_from($self, %params)->post || die;
252 $self->link_to_record($invoice);
253 # TODO extend link_to_record for items, otherwise long-term no d.r.y.
254 foreach my $item (@{ $invoice->items }) {
255 foreach (qw(orderitems)) {
256 if ($item->{"converted_from_${_}_id"}) {
257 die unless $item->{id};
258 RecordLinks->create_links('mode' => 'ids',
260 'from_ids' => $item->{"converted_from_${_}_id"},
261 'to_table' => 'invoice',
262 'to_id' => $item->{id},
264 delete $item->{"converted_from_${_}_id"};
268 $self->update_attributes(closed => 1);
277 sub convert_to_delivery_order {
278 my ($self, @args) = @_;
281 if (!$self->db->with_transaction(sub {
282 require SL::DB::DeliveryOrder;
283 $delivery_order = SL::DB::DeliveryOrder->new_from($self, @args);
284 $delivery_order->save;
285 $self->link_to_record($delivery_order);
286 # TODO extend link_to_record for items, otherwise long-term no d.r.y.
287 foreach my $item (@{ $delivery_order->items }) {
288 foreach (qw(orderitems)) { # expand if needed (delivery_order_items)
289 if ($item->{"converted_from_${_}_id"}) {
290 die unless $item->{id};
291 RecordLinks->create_links('dbh' => $self->db->dbh,
294 'from_ids' => $item->{"converted_from_${_}_id"},
295 'to_table' => 'delivery_order_items',
296 'to_id' => $item->{id},
298 delete $item->{"converted_from_${_}_id"};
303 $self->update_attributes(delivered => 1) unless $::instance_conf->get_shipped_qty_require_stock_out;
309 return $delivery_order;
312 sub _clone_orderitem_cvar {
315 my $cloned = $_->clone_and_reset;
316 $cloned->sub_module('orderitems');
322 my ($class, $source, %params) = @_;
324 croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
325 croak("A destination type must be given as parameter") unless $params{destination_type};
327 my $destination_type = delete $params{destination_type};
330 { from => 'sales_quotation', to => 'sales_order', abbr => 'sqso' },
331 { from => 'request_quotation', to => 'purchase_order', abbr => 'rqpo' },
332 { from => 'sales_quotation', to => 'sales_quotation', abbr => 'sqsq' },
333 { from => 'sales_order', to => 'sales_order', abbr => 'soso' },
334 { from => 'request_quotation', to => 'request_quotation', abbr => 'rqrq' },
335 { from => 'purchase_order', to => 'purchase_order', abbr => 'popo' },
336 { from => 'sales_order', to => 'purchase_order', abbr => 'sopo' },
337 { from => 'purchase_order', to => 'sales_order', abbr => 'poso' },
338 { from => 'sales_order', to => 'sales_quotation', abbr => 'sosq' },
339 { from => 'purchase_order', to => 'request_quotation', abbr => 'porq' },
341 my $from_to = (grep { $_->{from} eq $source->type && $_->{to} eq $destination_type} @from_tos)[0];
342 croak("Cannot convert from '" . $source->type . "' to '" . $destination_type . "'") if !$from_to;
344 my $is_abbr_any = sub {
345 any { $from_to->{abbr} eq $_ } @_;
348 my ($item_parent_id_column, $item_parent_column);
350 if (ref($source) eq 'SL::DB::Order') {
351 $item_parent_id_column = 'trans_id';
352 $item_parent_column = 'order';
355 my %args = ( map({ ( $_ => $source->$_ ) } qw(amount cp_id currency_id cusordnumber customer_id delivery_customer_id delivery_term_id delivery_vendor_id
356 department_id exchangerate globalproject_id intnotes marge_percent marge_total language_id netamount notes
357 ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded tax_point taxzone_id
358 transaction_description vendor_id billing_address_id
360 quotation => !!($destination_type =~ m{quotation$}),
363 transdate => DateTime->today_local,
364 employee => SL::DB::Manager::Employee->current,
367 if ( $is_abbr_any->(qw(sopo poso)) ) {
368 $args{ordnumber} = undef;
369 $args{quonumber} = undef;
370 $args{reqdate} = DateTime->today_local->next_workday();
372 if ( $is_abbr_any->(qw(sopo)) ) {
373 $args{customer_id} = undef;
374 $args{salesman_id} = undef;
375 $args{payment_id} = undef;
376 $args{delivery_term_id} = undef;
378 if ( $is_abbr_any->(qw(poso)) ) {
379 $args{vendor_id} = undef;
381 if ( $is_abbr_any->(qw(soso)) ) {
382 $args{periodic_invoices_config} = $source->periodic_invoices_config->clone_and_reset if $source->periodic_invoices_config;
384 if ( $is_abbr_any->(qw(sosq porq)) ) {
385 $args{ordnumber} = undef;
386 $args{quonumber} = undef;
387 $args{reqdate} = DateTime->today_local->next_workday();
390 # Custom shipto addresses (the ones specific to the sales/purchase
391 # record and not to the customer/vendor) are only linked from
392 # shipto → order. Meaning order.shipto_id
393 # will not be filled in that case.
394 if (!$source->shipto_id && $source->id) {
395 $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
398 $args{shipto_id} = $source->shipto_id;
401 my $order = $class->new(%args);
402 $order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
403 my $items = delete($params{items}) || $source->items_sorted;
408 my $source_item = $_;
409 my $source_item_id = $_->$item_parent_id_column;
410 my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
412 $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
413 my $item_parent = $item_parents{$source_item_id};
415 my $current_oe_item = SL::DB::OrderItem->new(map({ ( $_ => $source_item->$_ ) }
416 qw(active_discount_source active_price_source base_qty cusordnumber
417 description discount lastcost longdescription
418 marge_percent marge_price_factor marge_total
419 ordnumber parts_id price_factor price_factor_id pricegroup_id
420 project_id qty reqdate sellprice serialnumber ship subtotal transdate unit
423 custom_variables => \@custom_variables,
425 if ( $is_abbr_any->(qw(sopo)) ) {
426 $current_oe_item->sellprice($source_item->lastcost);
427 $current_oe_item->discount(0);
429 if ( $is_abbr_any->(qw(poso)) ) {
430 $current_oe_item->lastcost($source_item->sellprice);
432 $current_oe_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
436 @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
437 @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
438 @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
440 $order->items(\@items);
446 my ($class, $sources, %params) = @_;
448 croak("Unsupported object type in sources") if any { ref($_) !~ m{SL::DB::Order} } @$sources;
449 croak("Cannot create order for purchase records") if any { !$_->is_sales } @$sources;
450 croak("Cannot create order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
452 # bb: todo: check shipto: is it enough to check the ids or do we have to compare the entries?
453 if (delete $params{check_same_shipto}) {
454 die "check same shipto address is not implemented yet";
455 die "Source records do not have the same shipto" if 1;
459 if (defined $params{sort_sources_by}) {
460 my $sort_by = delete $params{sort_sources_by};
461 if ($sources->[0]->can($sort_by)) {
462 $sources = [ sort { $a->$sort_by cmp $b->$sort_by } @$sources ];
464 die "Cannot sort source records by $sort_by";
468 # set this entries to undef that yield different information
470 foreach my $attr (qw(ordnumber transdate reqdate tax_point taxincluded shippingpoint
471 shipvia notes closed delivered reqdate quonumber
472 cusordnumber proforma transaction_description
473 order_probability expected_billing_date)) {
474 $attributes{$attr} = undef if any { ($sources->[0]->$attr//'') ne ($_->$attr//'') } @$sources;
476 foreach my $attr (qw(cp_id currency_id salesman_id department_id
477 delivery_customer_id delivery_vendor_id shipto_id
478 globalproject_id exchangerate)) {
479 $attributes{$attr} = undef if any { ($sources->[0]->$attr||0) != ($_->$attr||0) } @$sources;
482 # set this entries from customer that yield different information
483 foreach my $attr (qw(language_id taxzone_id payment_id delivery_term_id)) {
484 $attributes{$attr} = $sources->[0]->customervendor->$attr if any { ($sources->[0]->$attr||0) != ($_->$attr||0) } @$sources;
486 $attributes{intnotes} = $sources->[0]->customervendor->notes if any { ($sources->[0]->intnotes//'') ne ($_->intnotes//'') } @$sources;
488 # no periodic invoice config for new order
489 $attributes{periodic_invoices_config} = undef;
491 # set emplyee to the current one
492 $attributes{employee} = SL::DB::Manager::Employee->current;
494 # copy global ordnumber, transdate, cusordnumber into item scope
495 # unless already present there
496 foreach my $attr (qw(ordnumber transdate cusordnumber)) {
497 foreach my $src (@$sources) {
498 foreach my $item (@{ $src->items_sorted }) {
499 $item->$attr($src->$attr) if !$item->$attr;
506 push @items, @{$_->items_sorted} for @$sources;
507 # make order from first source and all items
508 my $order = $class->new_from($sources->[0],
509 destination_type => 'sales_order',
510 attributes => \%attributes,
520 return if !$self->type;
522 my %number_method = (
523 sales_order => 'ordnumber',
524 sales_quotation => 'quonumber',
525 purchase_order => 'ordnumber',
526 request_quotation => 'quonumber',
529 return $self->${ \ $number_method{$self->type} }(@_);
533 $_[0]->is_sales ? $_[0]->customer : $_[0]->vendor;
543 sprintf "%s %s %s (%s)",
545 $self->customervendor->name,
546 $self->amount_as_number,
547 $self->date->to_kivitendo;
560 SL::DB::Order - Order Datenbank Objekt.
566 Returns one of the following string types:
574 =item sales_quotation
576 =item request_quotation
580 =head2 C<is_type TYPE>
582 Returns true if the order is of the given type.
584 =head2 C<daily_exchangerate $val>
586 Gets or sets the exchangerate object's value. This is the value from the
587 table C<exchangerate> depending on the order's currency, the transdate and
588 if it is a sales or purchase order.
590 The order object (respectively the table C<oe>) has an own column
591 C<exchangerate> which can be get or set with the accessor C<exchangerate>.
593 The idea is to drop the legacy table C<exchangerate> in the future and to
594 give all relevant tables it's own C<exchangerate> column.
596 So, this method is here if you need to access the "legacy" exchangerate via
603 (optional) If given, the exchangerate in the "legacy" table is set to this
604 value, depending on currency, transdate and sales or purchase.
608 =head2 C<convert_to_delivery_order %params>
610 Creates a new delivery order with C<$self> as the basis by calling
611 L<SL::DB::DeliveryOrder::new_from>. That delivery order is saved, and
612 C<$self> is linked to the new invoice via
613 L<SL::DB::RecordLink>. C<$self>'s C<delivered> attribute is set to
614 C<true>, and C<$self> is saved.
616 The arguments in C<%params> are passed to
617 L<SL::DB::DeliveryOrder::new_from>.
619 Returns C<undef> on failure. Otherwise the new delivery order will be
622 =head2 C<convert_to_invoice %params>
624 Creates a new invoice with C<$self> as the basis by calling
625 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
626 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
627 C<closed> attribute is set to C<true>, and C<$self> is saved.
629 The arguments in C<%params> are passed to L<SL::DB::Invoice::new_from>.
631 Returns the new invoice instance on success and C<undef> on
632 failure. The whole process is run inside a transaction. On failure
633 nothing is created or changed in the database.
635 At the moment only sales quotations and sales orders can be converted.
637 =head2 C<new_from $source, %params>
639 Creates a new C<SL::DB::Order> instance and copies as much
640 information from C<$source> as possible. At the moment only records with the
641 same destination type as the source type and sales orders from
642 sales quotations and purchase orders from requests for quotations can be
645 The C<transdate> field will be set to the current date.
647 The conversion copies the order items as well.
649 Returns the new order instance. The object returned is not
652 C<%params> can include the following options
653 (C<destination_type> is mandatory):
657 =item C<destination_type>
660 The type of the newly created object. Can be C<sales_quotation>,
661 C<sales_order>, C<purchase_quotation> or C<purchase_order> for now.
665 An optional array reference of RDBO instances for the items to use. If
666 missing then the method C<items_sorted> will be called on
667 C<$source>. This option can be used to override the sorting, to
668 exclude certain positions or to add additional ones.
670 =item C<skip_items_negative_qty>
672 If trueish then items with a negative quantity are skipped. Items with
673 a quantity of 0 are not affected by this option.
675 =item C<skip_items_zero_qty>
677 If trueish then items with a quantity of 0 are skipped.
681 An optional code reference that is called for each item with the item
682 as its sole parameter. Items for which the code reference returns a
683 falsish value will be skipped.
687 An optional hash reference. If it exists then it is passed to C<new>
688 allowing the caller to set certain attributes for the new delivery
693 =head2 C<new_from_multi $sources, %params>
695 Creates a new C<SL::DB::Order> instance from multiple sources and copies as
696 much information from C<$sources> as possible.
697 At the moment only sales orders can be combined and they must be of the same
700 The new order is created from the first one using C<new_from> and the positions
701 of all orders are added to the new order. The orders can be sorted with the
702 parameter C<sort_sources_by>.
704 The orders attributes are kept if they contain the same information for all
705 source orders an will be set to empty if they contain different information.
707 Returns the new order instance. The object returned is not
710 C<params> other then C<sort_sources_by> are passed to C<new_from>.
718 Sven Schöling <s.schoeling@linet-services.de>