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');
63 sub _before_save_set_ord_quo_number {
66 # ordnumber is 'NOT NULL'. Therefore make sure it's always set to at
67 # least an empty string, even if we're saving a quotation.
68 $self->ordnumber('') if !$self->ordnumber;
70 my $field = $self->quotation ? 'quonumber' : 'ordnumber';
71 $self->create_trans_number if !$self->$field;
78 sub items { goto &orderitems; }
79 sub add_items { goto &add_orderitems; }
80 sub record_number { goto &number; }
85 return 'sales_order' if $self->customer_id && ! $self->quotation;
86 return 'purchase_order' if $self->vendor_id && ! $self->quotation;
87 return 'sales_quotation' if $self->customer_id && $self->quotation;
88 return 'request_quotation' if $self->vendor_id && $self->quotation;
94 return shift->type eq shift;
98 # oe doesn't have deliverydate, but PTC checks for deliverydate or transdate to determine tax
99 # oe can't deal with deviating tax rates, but at least make sure PTC doesn't barf
100 return shift->transdate;
103 sub displayable_type {
104 my $type = shift->type;
106 return $::locale->text('Sales quotation') if $type eq 'sales_quotation';
107 return $::locale->text('Request quotation') if $type eq 'request_quotation';
108 return $::locale->text('Sales Order') if $type eq 'sales_order';
109 return $::locale->text('Purchase Order') if $type eq 'purchase_order';
114 sub displayable_name {
115 join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
119 croak 'not an accessor' if @_ > 1;
120 return !!shift->customer_id;
123 sub daily_exchangerate {
124 my ($self, $val) = @_;
126 return 1 if $self->currency_id == $::instance_conf->get_currency_id;
128 my $rate = (any { $self->is_type($_) } qw(sales_quotation sales_order)) ? 'buy'
129 : (any { $self->is_type($_) } qw(request_quotation purchase_order)) ? 'sell'
134 croak t8('exchange rate has to be positive') if $val <= 0;
135 if (!$self->exchangerate_obj) {
136 $self->exchangerate_obj(SL::DB::Exchangerate->new(
137 currency_id => $self->currency_id,
138 transdate => $self->transdate,
141 } elsif (!defined $self->exchangerate_obj->$rate) {
142 $self->exchangerate_obj->$rate($val);
144 croak t8('exchange rate already exists, no update allowed');
147 return $self->exchangerate_obj->$rate if $self->exchangerate_obj;
154 if ($self->quotation) {
157 require SL::DB::Invoice;
158 return SL::DB::Manager::Invoice->get_all(
160 ordnumber => $self->ordnumber,
161 @{ $params{query} || [] },
167 sub displayable_state {
170 return $self->closed ? $::locale->text('closed') : $::locale->text('open');
173 sub abschlag_invoices {
174 return shift()->invoices(query => [ abschlag => 1 ]);
178 return shift()->invoices(query => [ abschlag => 0 ]);
181 sub convert_to_invoice {
182 my ($self, %params) = @_;
184 croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
187 if (!$self->db->with_transaction(sub {
188 require SL::DB::Invoice;
189 $invoice = SL::DB::Invoice->new_from($self)->post(%params) || die;
190 $self->link_to_record($invoice);
191 $self->update_attributes(closed => 1);
200 sub convert_to_delivery_order {
201 my ($self, @args) = @_;
204 if (!$self->db->with_transaction(sub {
205 require SL::DB::DeliveryOrder;
206 $delivery_order = SL::DB::DeliveryOrder->new_from($self, @args);
207 $delivery_order->save;
208 $self->link_to_record($delivery_order);
209 # TODO extend link_to_record for items, otherwise long-term no d.r.y.
210 foreach my $item (@{ $delivery_order->items }) {
211 foreach (qw(orderitems)) { # expand if needed (delivery_order_items)
212 if ($item->{"converted_from_${_}_id"}) {
213 die unless $item->{id};
214 RecordLinks->create_links('dbh' => $self->db->dbh,
217 'from_ids' => $item->{"converted_from_${_}_id"},
218 'to_table' => 'delivery_order_items',
219 'to_id' => $item->{id},
221 delete $item->{"converted_from_${_}_id"};
226 $self->update_attributes(delivered => 1);
232 return $delivery_order;
235 sub _clone_orderitem_cvar {
238 my $cloned = $_->clone_and_reset;
239 $cloned->sub_module('orderitems');
245 my ($class, $source, %params) = @_;
247 croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
248 croak("A destination type must be given as parameter") unless $params{destination_type};
250 my $destination_type = delete $params{destination_type};
253 { from => 'sales_quotation', to => 'sales_order', abbr => 'sqso' },
254 { from => 'request_quotation', to => 'purchase_order', abbr => 'rqpo' },
255 { from => 'sales_quotation', to => 'sales_quotation', abbr => 'sqsq' },
256 { from => 'sales_order', to => 'sales_order', abbr => 'soso' },
257 { from => 'request_quotation', to => 'request_quotation', abbr => 'rqrq' },
258 { from => 'purchase_order', to => 'purchase_order', abbr => 'popo' },
259 { from => 'sales_order', to => 'purchase_order', abbr => 'sopo' },
260 { from => 'purchase_order', to => 'sales_order', abbr => 'poso' },
262 my $from_to = (grep { $_->{from} eq $source->type && $_->{to} eq $destination_type} @from_tos)[0];
263 croak("Cannot convert from '" . $source->type . "' to '" . $destination_type . "'") if !$from_to;
265 my $is_abbr_any = sub {
266 # foreach my $abbr (@_) {
267 # croak "no such abbreviation: '$abbr'" if !grep { $_->{abbr} eq $abbr } @from_tos;
269 any { $from_to->{abbr} eq $_ } @_;
272 my ($item_parent_id_column, $item_parent_column);
274 if (ref($source) eq 'SL::DB::Order') {
275 $item_parent_id_column = 'trans_id';
276 $item_parent_column = 'order';
279 my %args = ( map({ ( $_ => $source->$_ ) } qw(amount cp_id currency_id cusordnumber customer_id delivery_customer_id delivery_term_id delivery_vendor_id
280 department_id employee_id globalproject_id intnotes marge_percent marge_total language_id netamount notes
281 ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id
282 transaction_description vendor_id
284 quotation => !!($destination_type =~ m{quotation$}),
287 transdate => DateTime->today_local,
290 if ( $is_abbr_any->(qw(sopo poso)) ) {
291 $args{ordnumber} = undef;
292 $args{reqdate} = DateTime->today_local->next_workday();
293 $args{employee} = SL::DB::Manager::Employee->current;
295 if ( $is_abbr_any->(qw(sopo)) ) {
296 $args{customer_id} = undef;
297 $args{salesman_id} = undef;
298 $args{payment_id} = undef;
299 $args{delivery_term_id} = undef;
301 if ( $is_abbr_any->(qw(poso)) ) {
302 $args{vendor_id} = undef;
304 if ( $is_abbr_any->(qw(soso)) ) {
305 $args{periodic_invoices_config} = $source->periodic_invoices_config->clone_and_reset if $source->periodic_invoices_config;
308 # Custom shipto addresses (the ones specific to the sales/purchase
309 # record and not to the customer/vendor) are only linked from
310 # shipto → order. Meaning order.shipto_id
311 # will not be filled in that case.
312 if (!$source->shipto_id && $source->id) {
313 $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
316 $args{shipto_id} = $source->shipto_id;
319 my $order = $class->new(%args);
320 $order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
321 my $items = delete($params{items}) || $source->items_sorted;
326 my $source_item = $_;
327 my $source_item_id = $_->$item_parent_id_column;
328 my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
330 $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
331 my $item_parent = $item_parents{$source_item_id};
333 my $current_oe_item = SL::DB::OrderItem->new(map({ ( $_ => $source_item->$_ ) }
334 qw(active_discount_source active_price_source base_qty cusordnumber
335 description discount lastcost longdescription
336 marge_percent marge_price_factor marge_total
337 ordnumber parts_id price_factor price_factor_id pricegroup_id
338 project_id qty reqdate sellprice serialnumber ship subtotal transdate unit
340 custom_variables => \@custom_variables,
342 if ( $is_abbr_any->(qw(sopo)) ) {
343 $current_oe_item->sellprice($source_item->lastcost);
344 $current_oe_item->discount(0);
346 if ( $is_abbr_any->(qw(poso)) ) {
347 $current_oe_item->lastcost($source_item->sellprice);
349 $current_oe_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
353 @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
354 @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
355 @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
357 $order->items(\@items);
363 my ($class, $sources, %params) = @_;
365 croak("Unsupported object type in sources") if any { ref($_) !~ m{SL::DB::Order} } @$sources;
366 croak("Cannot create order for purchase records") if any { !$_->is_sales } @$sources;
367 croak("Cannot create order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
369 # bb: todo: check shipto: is it enough to check the ids or do we have to compare the entries?
370 if (delete $params{check_same_shipto}) {
371 die "check same shipto address is not implemented yet";
372 die "Source records do not have the same shipto" if 1;
376 if (defined $params{sort_sources_by}) {
377 my $sort_by = delete $params{sort_sources_by};
378 if ($sources->[0]->can($sort_by)) {
379 $sources = [ sort { $a->$sort_by cmp $b->$sort_by } @$sources ];
381 die "Cannot sort source records by $sort_by";
385 # set this entries to undef that yield different information
387 foreach my $attr (qw(ordnumber transdate reqdate taxincluded shippingpoint
388 shipvia notes closed delivered reqdate quonumber
389 cusordnumber proforma transaction_description
390 order_probability expected_billing_date)) {
391 $attributes{$attr} = undef if any { ($sources->[0]->$attr//'') ne ($_->$attr//'') } @$sources;
393 foreach my $attr (qw(cp_id currency_id employee_id salesman_id department_id
394 delivery_customer_id delivery_vendor_id shipto_id
396 $attributes{$attr} = undef if any { ($sources->[0]->$attr||0) != ($_->$attr||0) } @$sources;
399 # set this entries from customer that yield different information
400 foreach my $attr (qw(language_id taxzone_id payment_id delivery_term_id)) {
401 $attributes{$attr} = $sources->[0]->customervendor->$attr if any { ($sources->[0]->$attr||0) != ($_->$attr||0) } @$sources;
403 $attributes{intnotes} = $sources->[0]->customervendor->notes if any { ($sources->[0]->intnotes//'') ne ($_->intnotes//'') } @$sources;
405 # no periodic invoice config for new order
406 $attributes{periodic_invoices_config} = undef;
408 # copy global ordnumber, transdate, cusordnumber into item scope
409 # unless already present there
410 foreach my $attr (qw(ordnumber transdate cusordnumber)) {
411 foreach my $src (@$sources) {
412 foreach my $item (@{ $src->items_sorted }) {
413 $item->$attr($src->$attr) if !$item->$attr;
420 push @items, @{$_->items_sorted} for @$sources;
421 # make order from first source and all items
422 my $order = $class->new_from($sources->[0],
423 destination_type => 'sales_order',
424 attributes => \%attributes,
434 return if !$self->type;
436 my %number_method = (
437 sales_order => 'ordnumber',
438 sales_quotation => 'quonumber',
439 purchase_order => 'ordnumber',
440 request_quotation => 'quonumber',
443 return $self->${ \ $number_method{$self->type} }(@_);
447 $_[0]->is_sales ? $_[0]->customer : $_[0]->vendor;
457 sprintf "%s %s %s (%s)",
459 $self->customervendor->name,
460 $self->amount_as_number,
461 $self->date->to_kivitendo;
474 SL::DB::Order - Order Datenbank Objekt.
480 Returns one of the following string types:
488 =item sales_quotation
490 =item request_quotation
494 =head2 C<is_type TYPE>
496 Returns true if the order is of the given type.
498 =head2 C<daily_exchangerate $val>
500 Gets or sets the exchangerate object's value. This is the value from the
501 table C<exchangerate> depending on the order's currency, the transdate and
502 if it is a sales or purchase order.
504 The order object (respectively the table C<oe>) has an own column
505 C<exchangerate> which can be get or set with the accessor C<exchangerate>.
507 The idea is to drop the legacy table C<exchangerate> in the future and to
508 give all relevant tables it's own C<exchangerate> column.
510 So, this method is here if you need to access the "legacy" exchangerate via
517 (optional) If given, the exchangerate in the "legacy" table is set to this
518 value, depending on currency, transdate and sales or purchase.
522 =head2 C<convert_to_delivery_order %params>
524 Creates a new delivery order with C<$self> as the basis by calling
525 L<SL::DB::DeliveryOrder::new_from>. That delivery order is saved, and
526 C<$self> is linked to the new invoice via
527 L<SL::DB::RecordLink>. C<$self>'s C<delivered> attribute is set to
528 C<true>, and C<$self> is saved.
530 The arguments in C<%params> are passed to
531 L<SL::DB::DeliveryOrder::new_from>.
533 Returns C<undef> on failure. Otherwise the new delivery order will be
536 =head2 C<convert_to_invoice %params>
538 Creates a new invoice with C<$self> as the basis by calling
539 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
540 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
541 C<closed> attribute is set to C<true>, and C<$self> is saved.
543 The arguments in C<%params> are passed to L<SL::DB::Invoice::post>.
545 Returns the new invoice instance on success and C<undef> on
546 failure. The whole process is run inside a transaction. On failure
547 nothing is created or changed in the database.
549 At the moment only sales quotations and sales orders can be converted.
551 =head2 C<new_from $source, %params>
553 Creates a new C<SL::DB::Order> instance and copies as much
554 information from C<$source> as possible. At the moment only records with the
555 same destination type as the source type and sales orders from
556 sales quotations and purchase orders from requests for quotations can be
559 The C<transdate> field will be set to the current date.
561 The conversion copies the order items as well.
563 Returns the new order instance. The object returned is not
566 C<%params> can include the following options
567 (C<destination_type> is mandatory):
571 =item C<destination_type>
574 The type of the newly created object. Can be C<sales_quotation>,
575 C<sales_order>, C<purchase_quotation> or C<purchase_order> for now.
579 An optional array reference of RDBO instances for the items to use. If
580 missing then the method C<items_sorted> will be called on
581 C<$source>. This option can be used to override the sorting, to
582 exclude certain positions or to add additional ones.
584 =item C<skip_items_negative_qty>
586 If trueish then items with a negative quantity are skipped. Items with
587 a quantity of 0 are not affected by this option.
589 =item C<skip_items_zero_qty>
591 If trueish then items with a quantity of 0 are skipped.
595 An optional code reference that is called for each item with the item
596 as its sole parameter. Items for which the code reference returns a
597 falsish value will be skipped.
601 An optional hash reference. If it exists then it is passed to C<new>
602 allowing the caller to set certain attributes for the new delivery
607 =head2 C<new_from_multi $sources, %params>
609 Creates a new C<SL::DB::Order> instance from multiple sources and copies as
610 much information from C<$sources> as possible.
611 At the moment only sales orders can be combined and they must be of the same
614 The new order is created from the first one using C<new_from> and the positions
615 of all orders are added to the new order. The orders can be sorted with the
616 parameter C<sort_sources_by>.
618 The orders attributes are kept if they contain the same information for all
619 source orders an will be set to empty if they contain different information.
621 Returns the new order instance. The object returned is not
624 C<params> other then C<sort_sources_by> are passed to C<new_from>.
632 Sven Schöling <s.schoeling@linet-services.de>