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 PTC checks for deliverydate or transdate to determine tax
143 # oe can't deal with deviating tax rates, but at least make sure PTC doesn't barf
144 return shift->transdate;
147 sub effective_tax_point {
150 return $self->tax_point || $self->transdate;
153 sub displayable_type {
154 my $type = shift->type;
156 return $::locale->text('Sales quotation') if $type eq 'sales_quotation';
157 return $::locale->text('Request quotation') if $type eq 'request_quotation';
158 return $::locale->text('Sales Order') if $type eq 'sales_order';
159 return $::locale->text('Purchase Order') if $type eq 'purchase_order';
164 sub displayable_name {
165 join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
169 croak 'not an accessor' if @_ > 1;
170 return !!shift->customer_id;
173 sub daily_exchangerate {
174 my ($self, $val) = @_;
176 return 1 if $self->currency_id == $::instance_conf->get_currency_id;
178 my $rate = (any { $self->is_type($_) } qw(sales_quotation sales_order)) ? 'buy'
179 : (any { $self->is_type($_) } qw(request_quotation purchase_order)) ? 'sell'
184 croak t8('exchange rate has to be positive') if $val <= 0;
185 if (!$self->exchangerate_obj) {
186 $self->exchangerate_obj(SL::DB::Exchangerate->new(
187 currency_id => $self->currency_id,
188 transdate => $self->transdate,
191 } elsif (!defined $self->exchangerate_obj->$rate) {
192 $self->exchangerate_obj->$rate($val);
194 croak t8('exchange rate already exists, no update allowed');
197 return $self->exchangerate_obj->$rate if $self->exchangerate_obj;
204 if ($self->quotation) {
207 require SL::DB::Invoice;
208 return SL::DB::Manager::Invoice->get_all(
210 ordnumber => $self->ordnumber,
211 @{ $params{query} || [] },
217 sub displayable_state {
220 return $self->closed ? $::locale->text('closed') : $::locale->text('open');
223 sub abschlag_invoices {
224 return shift()->invoices(query => [ abschlag => 1 ]);
228 return shift()->invoices(query => [ abschlag => 0 ]);
231 sub convert_to_invoice {
232 my ($self, %params) = @_;
234 croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
237 if (!$self->db->with_transaction(sub {
238 require SL::DB::Invoice;
239 $invoice = SL::DB::Invoice->new_from($self)->post(%params) || die;
240 $self->link_to_record($invoice);
241 $self->update_attributes(closed => 1);
250 sub convert_to_delivery_order {
251 my ($self, @args) = @_;
254 if (!$self->db->with_transaction(sub {
255 require SL::DB::DeliveryOrder;
256 $delivery_order = SL::DB::DeliveryOrder->new_from($self, @args);
257 $delivery_order->save;
258 $self->link_to_record($delivery_order);
259 # TODO extend link_to_record for items, otherwise long-term no d.r.y.
260 foreach my $item (@{ $delivery_order->items }) {
261 foreach (qw(orderitems)) { # expand if needed (delivery_order_items)
262 if ($item->{"converted_from_${_}_id"}) {
263 die unless $item->{id};
264 RecordLinks->create_links('dbh' => $self->db->dbh,
267 'from_ids' => $item->{"converted_from_${_}_id"},
268 'to_table' => 'delivery_order_items',
269 'to_id' => $item->{id},
271 delete $item->{"converted_from_${_}_id"};
276 $self->update_attributes(delivered => 1);
282 return $delivery_order;
285 sub _clone_orderitem_cvar {
288 my $cloned = $_->clone_and_reset;
289 $cloned->sub_module('orderitems');
295 my ($class, $source, %params) = @_;
297 croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
298 croak("A destination type must be given as parameter") unless $params{destination_type};
300 my $destination_type = delete $params{destination_type};
303 { from => 'sales_quotation', to => 'sales_order', abbr => 'sqso' },
304 { from => 'request_quotation', to => 'purchase_order', abbr => 'rqpo' },
305 { from => 'sales_quotation', to => 'sales_quotation', abbr => 'sqsq' },
306 { from => 'sales_order', to => 'sales_order', abbr => 'soso' },
307 { from => 'request_quotation', to => 'request_quotation', abbr => 'rqrq' },
308 { from => 'purchase_order', to => 'purchase_order', abbr => 'popo' },
309 { from => 'sales_order', to => 'purchase_order', abbr => 'sopo' },
310 { from => 'purchase_order', to => 'sales_order', abbr => 'poso' },
312 my $from_to = (grep { $_->{from} eq $source->type && $_->{to} eq $destination_type} @from_tos)[0];
313 croak("Cannot convert from '" . $source->type . "' to '" . $destination_type . "'") if !$from_to;
315 my $is_abbr_any = sub {
316 # foreach my $abbr (@_) {
317 # croak "no such abbreviation: '$abbr'" if !grep { $_->{abbr} eq $abbr } @from_tos;
319 any { $from_to->{abbr} eq $_ } @_;
322 my ($item_parent_id_column, $item_parent_column);
324 if (ref($source) eq 'SL::DB::Order') {
325 $item_parent_id_column = 'trans_id';
326 $item_parent_column = 'order';
329 my %args = ( map({ ( $_ => $source->$_ ) } qw(amount cp_id currency_id cusordnumber customer_id delivery_customer_id delivery_term_id delivery_vendor_id
330 department_id employee_id exchangerate globalproject_id intnotes marge_percent marge_total language_id netamount notes
331 ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id
332 transaction_description vendor_id
334 quotation => !!($destination_type =~ m{quotation$}),
337 transdate => DateTime->today_local,
340 if ( $is_abbr_any->(qw(sopo poso)) ) {
341 $args{ordnumber} = undef;
342 $args{quonumber} = undef;
343 $args{reqdate} = DateTime->today_local->next_workday();
344 $args{employee} = SL::DB::Manager::Employee->current;
346 if ( $is_abbr_any->(qw(sopo)) ) {
347 $args{customer_id} = undef;
348 $args{salesman_id} = undef;
349 $args{payment_id} = undef;
350 $args{delivery_term_id} = undef;
352 if ( $is_abbr_any->(qw(poso)) ) {
353 $args{vendor_id} = undef;
355 if ( $is_abbr_any->(qw(soso)) ) {
356 $args{periodic_invoices_config} = $source->periodic_invoices_config->clone_and_reset if $source->periodic_invoices_config;
359 # Custom shipto addresses (the ones specific to the sales/purchase
360 # record and not to the customer/vendor) are only linked from
361 # shipto → order. Meaning order.shipto_id
362 # will not be filled in that case.
363 if (!$source->shipto_id && $source->id) {
364 $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
367 $args{shipto_id} = $source->shipto_id;
370 my $order = $class->new(%args);
371 $order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
372 my $items = delete($params{items}) || $source->items_sorted;
377 my $source_item = $_;
378 my $source_item_id = $_->$item_parent_id_column;
379 my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
381 $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
382 my $item_parent = $item_parents{$source_item_id};
384 my $current_oe_item = SL::DB::OrderItem->new(map({ ( $_ => $source_item->$_ ) }
385 qw(active_discount_source active_price_source base_qty cusordnumber
386 description discount lastcost longdescription
387 marge_percent marge_price_factor marge_total
388 ordnumber parts_id price_factor price_factor_id pricegroup_id
389 project_id qty reqdate sellprice serialnumber ship subtotal transdate unit
391 custom_variables => \@custom_variables,
393 if ( $is_abbr_any->(qw(sopo)) ) {
394 $current_oe_item->sellprice($source_item->lastcost);
395 $current_oe_item->discount(0);
397 if ( $is_abbr_any->(qw(poso)) ) {
398 $current_oe_item->lastcost($source_item->sellprice);
400 $current_oe_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
404 @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
405 @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
406 @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
408 $order->items(\@items);
414 my ($class, $sources, %params) = @_;
416 croak("Unsupported object type in sources") if any { ref($_) !~ m{SL::DB::Order} } @$sources;
417 croak("Cannot create order for purchase records") if any { !$_->is_sales } @$sources;
418 croak("Cannot create order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
420 # bb: todo: check shipto: is it enough to check the ids or do we have to compare the entries?
421 if (delete $params{check_same_shipto}) {
422 die "check same shipto address is not implemented yet";
423 die "Source records do not have the same shipto" if 1;
427 if (defined $params{sort_sources_by}) {
428 my $sort_by = delete $params{sort_sources_by};
429 if ($sources->[0]->can($sort_by)) {
430 $sources = [ sort { $a->$sort_by cmp $b->$sort_by } @$sources ];
432 die "Cannot sort source records by $sort_by";
436 # set this entries to undef that yield different information
438 foreach my $attr (qw(ordnumber transdate reqdate taxincluded shippingpoint
439 shipvia notes closed delivered reqdate quonumber
440 cusordnumber proforma transaction_description
441 order_probability expected_billing_date)) {
442 $attributes{$attr} = undef if any { ($sources->[0]->$attr//'') ne ($_->$attr//'') } @$sources;
444 foreach my $attr (qw(cp_id currency_id employee_id salesman_id department_id
445 delivery_customer_id delivery_vendor_id shipto_id
446 globalproject_id exchangerate)) {
447 $attributes{$attr} = undef if any { ($sources->[0]->$attr||0) != ($_->$attr||0) } @$sources;
450 # set this entries from customer that yield different information
451 foreach my $attr (qw(language_id taxzone_id payment_id delivery_term_id)) {
452 $attributes{$attr} = $sources->[0]->customervendor->$attr if any { ($sources->[0]->$attr||0) != ($_->$attr||0) } @$sources;
454 $attributes{intnotes} = $sources->[0]->customervendor->notes if any { ($sources->[0]->intnotes//'') ne ($_->intnotes//'') } @$sources;
456 # no periodic invoice config for new order
457 $attributes{periodic_invoices_config} = undef;
459 # copy global ordnumber, transdate, cusordnumber into item scope
460 # unless already present there
461 foreach my $attr (qw(ordnumber transdate cusordnumber)) {
462 foreach my $src (@$sources) {
463 foreach my $item (@{ $src->items_sorted }) {
464 $item->$attr($src->$attr) if !$item->$attr;
471 push @items, @{$_->items_sorted} for @$sources;
472 # make order from first source and all items
473 my $order = $class->new_from($sources->[0],
474 destination_type => 'sales_order',
475 attributes => \%attributes,
485 return if !$self->type;
487 my %number_method = (
488 sales_order => 'ordnumber',
489 sales_quotation => 'quonumber',
490 purchase_order => 'ordnumber',
491 request_quotation => 'quonumber',
494 return $self->${ \ $number_method{$self->type} }(@_);
498 $_[0]->is_sales ? $_[0]->customer : $_[0]->vendor;
508 sprintf "%s %s %s (%s)",
510 $self->customervendor->name,
511 $self->amount_as_number,
512 $self->date->to_kivitendo;
525 SL::DB::Order - Order Datenbank Objekt.
531 Returns one of the following string types:
539 =item sales_quotation
541 =item request_quotation
545 =head2 C<is_type TYPE>
547 Returns true if the order is of the given type.
549 =head2 C<daily_exchangerate $val>
551 Gets or sets the exchangerate object's value. This is the value from the
552 table C<exchangerate> depending on the order's currency, the transdate and
553 if it is a sales or purchase order.
555 The order object (respectively the table C<oe>) has an own column
556 C<exchangerate> which can be get or set with the accessor C<exchangerate>.
558 The idea is to drop the legacy table C<exchangerate> in the future and to
559 give all relevant tables it's own C<exchangerate> column.
561 So, this method is here if you need to access the "legacy" exchangerate via
568 (optional) If given, the exchangerate in the "legacy" table is set to this
569 value, depending on currency, transdate and sales or purchase.
573 =head2 C<convert_to_delivery_order %params>
575 Creates a new delivery order with C<$self> as the basis by calling
576 L<SL::DB::DeliveryOrder::new_from>. That delivery order is saved, and
577 C<$self> is linked to the new invoice via
578 L<SL::DB::RecordLink>. C<$self>'s C<delivered> attribute is set to
579 C<true>, and C<$self> is saved.
581 The arguments in C<%params> are passed to
582 L<SL::DB::DeliveryOrder::new_from>.
584 Returns C<undef> on failure. Otherwise the new delivery order will be
587 =head2 C<convert_to_invoice %params>
589 Creates a new invoice with C<$self> as the basis by calling
590 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
591 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
592 C<closed> attribute is set to C<true>, and C<$self> is saved.
594 The arguments in C<%params> are passed to L<SL::DB::Invoice::post>.
596 Returns the new invoice instance on success and C<undef> on
597 failure. The whole process is run inside a transaction. On failure
598 nothing is created or changed in the database.
600 At the moment only sales quotations and sales orders can be converted.
602 =head2 C<new_from $source, %params>
604 Creates a new C<SL::DB::Order> instance and copies as much
605 information from C<$source> as possible. At the moment only records with the
606 same destination type as the source type and sales orders from
607 sales quotations and purchase orders from requests for quotations can be
610 The C<transdate> field will be set to the current date.
612 The conversion copies the order items as well.
614 Returns the new order instance. The object returned is not
617 C<%params> can include the following options
618 (C<destination_type> is mandatory):
622 =item C<destination_type>
625 The type of the newly created object. Can be C<sales_quotation>,
626 C<sales_order>, C<purchase_quotation> or C<purchase_order> for now.
630 An optional array reference of RDBO instances for the items to use. If
631 missing then the method C<items_sorted> will be called on
632 C<$source>. This option can be used to override the sorting, to
633 exclude certain positions or to add additional ones.
635 =item C<skip_items_negative_qty>
637 If trueish then items with a negative quantity are skipped. Items with
638 a quantity of 0 are not affected by this option.
640 =item C<skip_items_zero_qty>
642 If trueish then items with a quantity of 0 are skipped.
646 An optional code reference that is called for each item with the item
647 as its sole parameter. Items for which the code reference returns a
648 falsish value will be skipped.
652 An optional hash reference. If it exists then it is passed to C<new>
653 allowing the caller to set certain attributes for the new delivery
658 =head2 C<new_from_multi $sources, %params>
660 Creates a new C<SL::DB::Order> instance from multiple sources and copies as
661 much information from C<$sources> as possible.
662 At the moment only sales orders can be combined and they must be of the same
665 The new order is created from the first one using C<new_from> and the positions
666 of all orders are added to the new order. The orders can be sorted with the
667 parameter C<sort_sources_by>.
669 The orders attributes are kept if they contain the same information for all
670 source orders an will be set to empty if they contain different information.
672 Returns the new order instance. The object returned is not
675 C<params> other then C<sort_sources_by> are passed to C<new_from>.
683 Sven Schöling <s.schoeling@linet-services.de>