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 displayable_type {
148 my $type = shift->type;
150 return $::locale->text('Sales quotation') if $type eq 'sales_quotation';
151 return $::locale->text('Request quotation') if $type eq 'request_quotation';
152 return $::locale->text('Sales Order') if $type eq 'sales_order';
153 return $::locale->text('Purchase Order') if $type eq 'purchase_order';
158 sub displayable_name {
159 join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
163 croak 'not an accessor' if @_ > 1;
164 return !!shift->customer_id;
167 sub daily_exchangerate {
168 my ($self, $val) = @_;
170 return 1 if $self->currency_id == $::instance_conf->get_currency_id;
172 my $rate = (any { $self->is_type($_) } qw(sales_quotation sales_order)) ? 'buy'
173 : (any { $self->is_type($_) } qw(request_quotation purchase_order)) ? 'sell'
178 croak t8('exchange rate has to be positive') if $val <= 0;
179 if (!$self->exchangerate_obj) {
180 $self->exchangerate_obj(SL::DB::Exchangerate->new(
181 currency_id => $self->currency_id,
182 transdate => $self->transdate,
185 } elsif (!defined $self->exchangerate_obj->$rate) {
186 $self->exchangerate_obj->$rate($val);
188 croak t8('exchange rate already exists, no update allowed');
191 return $self->exchangerate_obj->$rate if $self->exchangerate_obj;
198 if ($self->quotation) {
201 require SL::DB::Invoice;
202 return SL::DB::Manager::Invoice->get_all(
204 ordnumber => $self->ordnumber,
205 @{ $params{query} || [] },
211 sub displayable_state {
214 return $self->closed ? $::locale->text('closed') : $::locale->text('open');
217 sub abschlag_invoices {
218 return shift()->invoices(query => [ abschlag => 1 ]);
222 return shift()->invoices(query => [ abschlag => 0 ]);
225 sub convert_to_invoice {
226 my ($self, %params) = @_;
228 croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
231 if (!$self->db->with_transaction(sub {
232 require SL::DB::Invoice;
233 $invoice = SL::DB::Invoice->new_from($self)->post(%params) || die;
234 $self->link_to_record($invoice);
235 $self->update_attributes(closed => 1);
244 sub convert_to_delivery_order {
245 my ($self, @args) = @_;
248 if (!$self->db->with_transaction(sub {
249 require SL::DB::DeliveryOrder;
250 $delivery_order = SL::DB::DeliveryOrder->new_from($self, @args);
251 $delivery_order->save;
252 $self->link_to_record($delivery_order);
253 # TODO extend link_to_record for items, otherwise long-term no d.r.y.
254 foreach my $item (@{ $delivery_order->items }) {
255 foreach (qw(orderitems)) { # expand if needed (delivery_order_items)
256 if ($item->{"converted_from_${_}_id"}) {
257 die unless $item->{id};
258 RecordLinks->create_links('dbh' => $self->db->dbh,
261 'from_ids' => $item->{"converted_from_${_}_id"},
262 'to_table' => 'delivery_order_items',
263 'to_id' => $item->{id},
265 delete $item->{"converted_from_${_}_id"};
270 $self->update_attributes(delivered => 1);
276 return $delivery_order;
279 sub _clone_orderitem_cvar {
282 my $cloned = $_->clone_and_reset;
283 $cloned->sub_module('orderitems');
289 my ($class, $source, %params) = @_;
291 croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
292 croak("A destination type must be given as parameter") unless $params{destination_type};
294 my $destination_type = delete $params{destination_type};
297 { from => 'sales_quotation', to => 'sales_order', abbr => 'sqso' },
298 { from => 'request_quotation', to => 'purchase_order', abbr => 'rqpo' },
299 { from => 'sales_quotation', to => 'sales_quotation', abbr => 'sqsq' },
300 { from => 'sales_order', to => 'sales_order', abbr => 'soso' },
301 { from => 'request_quotation', to => 'request_quotation', abbr => 'rqrq' },
302 { from => 'purchase_order', to => 'purchase_order', abbr => 'popo' },
303 { from => 'sales_order', to => 'purchase_order', abbr => 'sopo' },
304 { from => 'purchase_order', to => 'sales_order', abbr => 'poso' },
306 my $from_to = (grep { $_->{from} eq $source->type && $_->{to} eq $destination_type} @from_tos)[0];
307 croak("Cannot convert from '" . $source->type . "' to '" . $destination_type . "'") if !$from_to;
309 my $is_abbr_any = sub {
310 # foreach my $abbr (@_) {
311 # croak "no such abbreviation: '$abbr'" if !grep { $_->{abbr} eq $abbr } @from_tos;
313 any { $from_to->{abbr} eq $_ } @_;
316 my ($item_parent_id_column, $item_parent_column);
318 if (ref($source) eq 'SL::DB::Order') {
319 $item_parent_id_column = 'trans_id';
320 $item_parent_column = 'order';
323 my %args = ( map({ ( $_ => $source->$_ ) } qw(amount cp_id currency_id cusordnumber customer_id delivery_customer_id delivery_term_id delivery_vendor_id
324 department_id employee_id exchangerate globalproject_id intnotes marge_percent marge_total language_id netamount notes
325 ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id
326 transaction_description vendor_id
328 quotation => !!($destination_type =~ m{quotation$}),
331 transdate => DateTime->today_local,
334 if ( $is_abbr_any->(qw(sopo poso)) ) {
335 $args{ordnumber} = undef;
336 $args{quonumber} = undef;
337 $args{reqdate} = DateTime->today_local->next_workday();
338 $args{employee} = SL::DB::Manager::Employee->current;
340 if ( $is_abbr_any->(qw(sopo)) ) {
341 $args{customer_id} = undef;
342 $args{salesman_id} = undef;
343 $args{payment_id} = undef;
344 $args{delivery_term_id} = undef;
346 if ( $is_abbr_any->(qw(poso)) ) {
347 $args{vendor_id} = undef;
349 if ( $is_abbr_any->(qw(soso)) ) {
350 $args{periodic_invoices_config} = $source->periodic_invoices_config->clone_and_reset if $source->periodic_invoices_config;
353 # Custom shipto addresses (the ones specific to the sales/purchase
354 # record and not to the customer/vendor) are only linked from
355 # shipto → order. Meaning order.shipto_id
356 # will not be filled in that case.
357 if (!$source->shipto_id && $source->id) {
358 $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
361 $args{shipto_id} = $source->shipto_id;
364 my $order = $class->new(%args);
365 $order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
366 my $items = delete($params{items}) || $source->items_sorted;
371 my $source_item = $_;
372 my $source_item_id = $_->$item_parent_id_column;
373 my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
375 $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
376 my $item_parent = $item_parents{$source_item_id};
378 my $current_oe_item = SL::DB::OrderItem->new(map({ ( $_ => $source_item->$_ ) }
379 qw(active_discount_source active_price_source base_qty cusordnumber
380 description discount lastcost longdescription
381 marge_percent marge_price_factor marge_total
382 ordnumber parts_id price_factor price_factor_id pricegroup_id
383 project_id qty reqdate sellprice serialnumber ship subtotal transdate unit
385 custom_variables => \@custom_variables,
387 if ( $is_abbr_any->(qw(sopo)) ) {
388 $current_oe_item->sellprice($source_item->lastcost);
389 $current_oe_item->discount(0);
391 if ( $is_abbr_any->(qw(poso)) ) {
392 $current_oe_item->lastcost($source_item->sellprice);
394 $current_oe_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
398 @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
399 @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
400 @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
402 $order->items(\@items);
408 my ($class, $sources, %params) = @_;
410 croak("Unsupported object type in sources") if any { ref($_) !~ m{SL::DB::Order} } @$sources;
411 croak("Cannot create order for purchase records") if any { !$_->is_sales } @$sources;
412 croak("Cannot create order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
414 # bb: todo: check shipto: is it enough to check the ids or do we have to compare the entries?
415 if (delete $params{check_same_shipto}) {
416 die "check same shipto address is not implemented yet";
417 die "Source records do not have the same shipto" if 1;
421 if (defined $params{sort_sources_by}) {
422 my $sort_by = delete $params{sort_sources_by};
423 if ($sources->[0]->can($sort_by)) {
424 $sources = [ sort { $a->$sort_by cmp $b->$sort_by } @$sources ];
426 die "Cannot sort source records by $sort_by";
430 # set this entries to undef that yield different information
432 foreach my $attr (qw(ordnumber transdate reqdate taxincluded shippingpoint
433 shipvia notes closed delivered reqdate quonumber
434 cusordnumber proforma transaction_description
435 order_probability expected_billing_date)) {
436 $attributes{$attr} = undef if any { ($sources->[0]->$attr//'') ne ($_->$attr//'') } @$sources;
438 foreach my $attr (qw(cp_id currency_id employee_id salesman_id department_id
439 delivery_customer_id delivery_vendor_id shipto_id
440 globalproject_id exchangerate)) {
441 $attributes{$attr} = undef if any { ($sources->[0]->$attr||0) != ($_->$attr||0) } @$sources;
444 # set this entries from customer that yield different information
445 foreach my $attr (qw(language_id taxzone_id payment_id delivery_term_id)) {
446 $attributes{$attr} = $sources->[0]->customervendor->$attr if any { ($sources->[0]->$attr||0) != ($_->$attr||0) } @$sources;
448 $attributes{intnotes} = $sources->[0]->customervendor->notes if any { ($sources->[0]->intnotes//'') ne ($_->intnotes//'') } @$sources;
450 # no periodic invoice config for new order
451 $attributes{periodic_invoices_config} = undef;
453 # copy global ordnumber, transdate, cusordnumber into item scope
454 # unless already present there
455 foreach my $attr (qw(ordnumber transdate cusordnumber)) {
456 foreach my $src (@$sources) {
457 foreach my $item (@{ $src->items_sorted }) {
458 $item->$attr($src->$attr) if !$item->$attr;
465 push @items, @{$_->items_sorted} for @$sources;
466 # make order from first source and all items
467 my $order = $class->new_from($sources->[0],
468 destination_type => 'sales_order',
469 attributes => \%attributes,
479 return if !$self->type;
481 my %number_method = (
482 sales_order => 'ordnumber',
483 sales_quotation => 'quonumber',
484 purchase_order => 'ordnumber',
485 request_quotation => 'quonumber',
488 return $self->${ \ $number_method{$self->type} }(@_);
492 $_[0]->is_sales ? $_[0]->customer : $_[0]->vendor;
502 sprintf "%s %s %s (%s)",
504 $self->customervendor->name,
505 $self->amount_as_number,
506 $self->date->to_kivitendo;
519 SL::DB::Order - Order Datenbank Objekt.
525 Returns one of the following string types:
533 =item sales_quotation
535 =item request_quotation
539 =head2 C<is_type TYPE>
541 Returns true if the order is of the given type.
543 =head2 C<daily_exchangerate $val>
545 Gets or sets the exchangerate object's value. This is the value from the
546 table C<exchangerate> depending on the order's currency, the transdate and
547 if it is a sales or purchase order.
549 The order object (respectively the table C<oe>) has an own column
550 C<exchangerate> which can be get or set with the accessor C<exchangerate>.
552 The idea is to drop the legacy table C<exchangerate> in the future and to
553 give all relevant tables it's own C<exchangerate> column.
555 So, this method is here if you need to access the "legacy" exchangerate via
562 (optional) If given, the exchangerate in the "legacy" table is set to this
563 value, depending on currency, transdate and sales or purchase.
567 =head2 C<convert_to_delivery_order %params>
569 Creates a new delivery order with C<$self> as the basis by calling
570 L<SL::DB::DeliveryOrder::new_from>. That delivery order is saved, and
571 C<$self> is linked to the new invoice via
572 L<SL::DB::RecordLink>. C<$self>'s C<delivered> attribute is set to
573 C<true>, and C<$self> is saved.
575 The arguments in C<%params> are passed to
576 L<SL::DB::DeliveryOrder::new_from>.
578 Returns C<undef> on failure. Otherwise the new delivery order will be
581 =head2 C<convert_to_invoice %params>
583 Creates a new invoice with C<$self> as the basis by calling
584 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
585 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
586 C<closed> attribute is set to C<true>, and C<$self> is saved.
588 The arguments in C<%params> are passed to L<SL::DB::Invoice::post>.
590 Returns the new invoice instance on success and C<undef> on
591 failure. The whole process is run inside a transaction. On failure
592 nothing is created or changed in the database.
594 At the moment only sales quotations and sales orders can be converted.
596 =head2 C<new_from $source, %params>
598 Creates a new C<SL::DB::Order> instance and copies as much
599 information from C<$source> as possible. At the moment only records with the
600 same destination type as the source type and sales orders from
601 sales quotations and purchase orders from requests for quotations can be
604 The C<transdate> field will be set to the current date.
606 The conversion copies the order items as well.
608 Returns the new order instance. The object returned is not
611 C<%params> can include the following options
612 (C<destination_type> is mandatory):
616 =item C<destination_type>
619 The type of the newly created object. Can be C<sales_quotation>,
620 C<sales_order>, C<purchase_quotation> or C<purchase_order> for now.
624 An optional array reference of RDBO instances for the items to use. If
625 missing then the method C<items_sorted> will be called on
626 C<$source>. This option can be used to override the sorting, to
627 exclude certain positions or to add additional ones.
629 =item C<skip_items_negative_qty>
631 If trueish then items with a negative quantity are skipped. Items with
632 a quantity of 0 are not affected by this option.
634 =item C<skip_items_zero_qty>
636 If trueish then items with a quantity of 0 are skipped.
640 An optional code reference that is called for each item with the item
641 as its sole parameter. Items for which the code reference returns a
642 falsish value will be skipped.
646 An optional hash reference. If it exists then it is passed to C<new>
647 allowing the caller to set certain attributes for the new delivery
652 =head2 C<new_from_multi $sources, %params>
654 Creates a new C<SL::DB::Order> instance from multiple sources and copies as
655 much information from C<$sources> as possible.
656 At the moment only sales orders can be combined and they must be of the same
659 The new order is created from the first one using C<new_from> and the positions
660 of all orders are added to the new order. The orders can be sorted with the
661 parameter C<sort_sources_by>.
663 The orders attributes are kept if they contain the same information for all
664 source orders an will be set to empty if they contain different information.
666 Returns the new order instance. The object returned is not
669 C<params> other then C<sort_sources_by> are passed to C<new_from>.
677 Sven Schöling <s.schoeling@linet-services.de>