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;
22 use Rose::DB::Object::Helpers qw(as_tree);
24 __PACKAGE__->meta->add_relationship(
26 type => 'one to many',
27 class => 'SL::DB::OrderItem',
28 column_map => { id => 'trans_id' },
30 with_objects => [ 'part' ]
33 periodic_invoices_config => {
35 class => 'SL::DB::PeriodicInvoicesConfig',
36 column_map => { id => 'oe_id' },
40 class => 'SL::DB::Shipto',
41 column_map => { id => 'trans_id' },
42 query_args => [ module => 'OE' ],
46 class => 'SL::DB::Exchangerate',
47 column_map => { currency_id => 'currency_id', transdate => 'transdate' },
51 SL::DB::Helper::Attr::make(__PACKAGE__, exchangerate => 'numeric');
53 __PACKAGE__->meta->initialize;
55 __PACKAGE__->attr_html('notes');
56 __PACKAGE__->attr_sorted('items');
58 __PACKAGE__->before_save('_before_save_set_ord_quo_number');
62 sub _before_save_set_ord_quo_number {
65 # ordnumber is 'NOT NULL'. Therefore make sure it's always set to at
66 # least an empty string, even if we're saving a quotation.
67 $self->ordnumber('') if !$self->ordnumber;
69 my $field = $self->quotation ? 'quonumber' : 'ordnumber';
70 $self->create_trans_number if !$self->$field;
77 sub items { goto &orderitems; }
78 sub add_items { goto &add_orderitems; }
79 sub record_number { goto &number; }
84 return 'sales_order' if $self->customer_id && ! $self->quotation;
85 return 'purchase_order' if $self->vendor_id && ! $self->quotation;
86 return 'sales_quotation' if $self->customer_id && $self->quotation;
87 return 'request_quotation' if $self->vendor_id && $self->quotation;
93 return shift->type eq shift;
97 # oe doesn't have deliverydate, but PTC checks for deliverydate or transdate to determine tax
98 # oe can't deal with deviating tax rates, but at least make sure PTC doesn't barf
99 return shift->transdate;
102 sub displayable_type {
103 my $type = shift->type;
105 return $::locale->text('Sales quotation') if $type eq 'sales_quotation';
106 return $::locale->text('Request quotation') if $type eq 'request_quotation';
107 return $::locale->text('Sales Order') if $type eq 'sales_order';
108 return $::locale->text('Purchase Order') if $type eq 'purchase_order';
113 sub displayable_name {
114 join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
118 croak 'not an accessor' if @_ > 1;
119 return !!shift->customer_id;
123 my ($self, $val) = @_;
125 return 1 if $self->currency_id == $::instance_conf->get_currency_id;
127 my $rate = $self->is_sales ? 'buy' : 'sell';
130 croak 'exchange rate has to be positive' if $val <= 0;
131 if (!$self->exchangerate_obj) {
132 $self->exchangerate_obj(SL::DB::Exchangerate->new(
133 currency_id => $self->currency_id,
134 transdate => $self->transdate,
137 } elsif (!defined $self->exchangerate_obj->$rate) {
138 $self->exchangerate_obj->$rate($val);
140 croak 'exchange rate already exists, no update allowed';
143 return $self->exchangerate_obj->$rate if $self->exchangerate_obj;
150 if ($self->quotation) {
153 require SL::DB::Invoice;
154 return SL::DB::Manager::Invoice->get_all(
156 ordnumber => $self->ordnumber,
157 @{ $params{query} || [] },
163 sub displayable_state {
166 return $self->closed ? $::locale->text('closed') : $::locale->text('open');
169 sub abschlag_invoices {
170 return shift()->invoices(query => [ abschlag => 1 ]);
174 return shift()->invoices(query => [ abschlag => 0 ]);
177 sub convert_to_invoice {
178 my ($self, %params) = @_;
180 croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
183 if (!$self->db->with_transaction(sub {
184 require SL::DB::Invoice;
185 $invoice = SL::DB::Invoice->new_from($self)->post(%params) || die;
186 $self->link_to_record($invoice);
187 $self->update_attributes(closed => 1);
196 sub convert_to_delivery_order {
197 my ($self, @args) = @_;
200 if (!$self->db->with_transaction(sub {
201 require SL::DB::DeliveryOrder;
202 $delivery_order = SL::DB::DeliveryOrder->new_from($self, @args);
203 $delivery_order->save;
204 $self->link_to_record($delivery_order);
205 # TODO extend link_to_record for items, otherwise long-term no d.r.y.
206 foreach my $item (@{ $delivery_order->items }) {
207 foreach (qw(orderitems)) { # expand if needed (delivery_order_items)
208 if ($item->{"converted_from_${_}_id"}) {
209 die unless $item->{id};
210 RecordLinks->create_links('dbh' => $self->db->dbh,
213 'from_ids' => $item->{"converted_from_${_}_id"},
214 'to_table' => 'delivery_order_items',
215 'to_id' => $item->{id},
217 delete $item->{"converted_from_${_}_id"};
222 $self->update_attributes(delivered => 1);
228 return $delivery_order;
231 sub _clone_orderitem_cvar {
234 my $cloned = $_->clone_and_reset;
235 $cloned->sub_module('orderitems');
241 my ($class, $source, %params) = @_;
243 croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
244 croak("A destination type must be given as parameter") unless $params{destination_type};
246 my $destination_type = delete $params{destination_type};
249 { from => 'sales_quotation', to => 'sales_order', abbr => 'sqso' },
250 { from => 'request_quotation', to => 'purchase_order', abbr => 'rqpo' },
251 { from => 'sales_quotation', to => 'sales_quotation', abbr => 'sqsq' },
252 { from => 'sales_order', to => 'sales_order', abbr => 'soso' },
253 { from => 'request_quotation', to => 'request_quotation', abbr => 'rqrq' },
254 { from => 'purchase_order', to => 'purchase_order', abbr => 'popo' },
255 { from => 'sales_order', to => 'purchase_order', abbr => 'sopo' },
256 { from => 'purchase_order', to => 'sales_order', abbr => 'poso' },
258 my $from_to = (grep { $_->{from} eq $source->type && $_->{to} eq $destination_type} @from_tos)[0];
259 croak("Cannot convert from '" . $source->type . "' to '" . $destination_type . "'") if !$from_to;
261 my $is_abbr_any = sub {
262 # foreach my $abbr (@_) {
263 # croak "no such abbreviation: '$abbr'" if !grep { $_->{abbr} eq $abbr } @from_tos;
265 any { $from_to->{abbr} eq $_ } @_;
268 my ($item_parent_id_column, $item_parent_column);
270 if (ref($source) eq 'SL::DB::Order') {
271 $item_parent_id_column = 'trans_id';
272 $item_parent_column = 'order';
275 my %args = ( map({ ( $_ => $source->$_ ) } qw(amount cp_id currency_id cusordnumber customer_id delivery_customer_id delivery_term_id delivery_vendor_id
276 department_id employee_id globalproject_id intnotes marge_percent marge_total language_id netamount notes
277 ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id
278 transaction_description vendor_id
280 quotation => !!($destination_type =~ m{quotation$}),
283 transdate => DateTime->today_local,
286 if ( $is_abbr_any->(qw(sopo poso)) ) {
287 $args{ordnumber} = undef;
288 $args{reqdate} = DateTime->today_local->next_workday();
289 $args{employee} = SL::DB::Manager::Employee->current;
291 if ( $is_abbr_any->(qw(sopo)) ) {
292 $args{customer_id} = undef;
293 $args{salesman_id} = undef;
294 $args{payment_id} = undef;
295 $args{delivery_term_id} = undef;
297 if ( $is_abbr_any->(qw(poso)) ) {
298 $args{vendor_id} = undef;
300 if ( $is_abbr_any->(qw(soso)) ) {
301 $args{periodic_invoices_config} = $source->periodic_invoices_config->clone_and_reset if $source->periodic_invoices_config;
304 # Custom shipto addresses (the ones specific to the sales/purchase
305 # record and not to the customer/vendor) are only linked from
306 # shipto → order. Meaning order.shipto_id
307 # will not be filled in that case.
308 if (!$source->shipto_id && $source->id) {
309 $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
312 $args{shipto_id} = $source->shipto_id;
315 my $order = $class->new(%args);
316 $order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
317 my $items = delete($params{items}) || $source->items_sorted;
322 my $source_item = $_;
323 my $source_item_id = $_->$item_parent_id_column;
324 my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
326 $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
327 my $item_parent = $item_parents{$source_item_id};
329 my $current_oe_item = SL::DB::OrderItem->new(map({ ( $_ => $source_item->$_ ) }
330 qw(active_discount_source active_price_source base_qty cusordnumber
331 description discount lastcost longdescription
332 marge_percent marge_price_factor marge_total
333 ordnumber parts_id price_factor price_factor_id pricegroup_id
334 project_id qty reqdate sellprice serialnumber ship subtotal transdate unit
336 custom_variables => \@custom_variables,
338 if ( $is_abbr_any->(qw(sopo)) ) {
339 $current_oe_item->sellprice($source_item->lastcost);
340 $current_oe_item->discount(0);
342 if ( $is_abbr_any->(qw(poso)) ) {
343 $current_oe_item->lastcost($source_item->sellprice);
345 $current_oe_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
349 @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
350 @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
351 @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
353 $order->items(\@items);
359 my ($class, $sources, %params) = @_;
361 croak("Unsupported object type in sources") if any { ref($_) !~ m{SL::DB::Order} } @$sources;
362 croak("Cannot create order for purchase records") if any { !$_->is_sales } @$sources;
363 croak("Cannot create order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
365 # bb: todo: check shipto: is it enough to check the ids or do we have to compare the entries?
366 if (delete $params{check_same_shipto}) {
367 die "check same shipto address is not implemented yet";
368 die "Source records do not have the same shipto" if 1;
372 if (defined $params{sort_sources_by}) {
373 my $sort_by = delete $params{sort_sources_by};
374 if ($sources->[0]->can($sort_by)) {
375 $sources = [ sort { $a->$sort_by cmp $b->$sort_by } @$sources ];
377 die "Cannot sort source records by $sort_by";
381 # set this entries to undef that yield different information
383 foreach my $attr (qw(ordnumber transdate reqdate taxincluded shippingpoint
384 shipvia notes closed delivered reqdate quonumber
385 cusordnumber proforma transaction_description
386 order_probability expected_billing_date)) {
387 $attributes{$attr} = undef if any { ($sources->[0]->$attr//'') ne ($_->$attr//'') } @$sources;
389 foreach my $attr (qw(cp_id currency_id employee_id salesman_id department_id
390 delivery_customer_id delivery_vendor_id shipto_id
392 $attributes{$attr} = undef if any { ($sources->[0]->$attr||0) != ($_->$attr||0) } @$sources;
395 # set this entries from customer that yield different information
396 foreach my $attr (qw(language_id taxzone_id payment_id delivery_term_id)) {
397 $attributes{$attr} = $sources->[0]->customervendor->$attr if any { ($sources->[0]->$attr||0) != ($_->$attr||0) } @$sources;
399 $attributes{intnotes} = $sources->[0]->customervendor->notes if any { ($sources->[0]->intnotes//'') ne ($_->intnotes//'') } @$sources;
401 # no periodic invoice config for new order
402 $attributes{periodic_invoices_config} = undef;
404 # copy global ordnumber, transdate, cusordnumber into item scope
405 # unless already present there
406 foreach my $attr (qw(ordnumber transdate cusordnumber)) {
407 foreach my $src (@$sources) {
408 foreach my $item (@{ $src->items_sorted }) {
409 $item->$attr($src->$attr) if !$item->$attr;
416 push @items, @{$_->items_sorted} for @$sources;
417 # make order from first source and all items
418 my $order = $class->new_from($sources->[0],
419 destination_type => 'sales_order',
420 attributes => \%attributes,
430 return if !$self->type;
432 my %number_method = (
433 sales_order => 'ordnumber',
434 sales_quotation => 'quonumber',
435 purchase_order => 'ordnumber',
436 request_quotation => 'quonumber',
439 return $self->${ \ $number_method{$self->type} }(@_);
443 $_[0]->is_sales ? $_[0]->customer : $_[0]->vendor;
453 sprintf "%s %s %s (%s)",
455 $self->customervendor->name,
456 $self->amount_as_number,
457 $self->date->to_kivitendo;
470 SL::DB::Order - Order Datenbank Objekt.
476 Returns one of the following string types:
484 =item sales_quotation
486 =item request_quotation
490 =head2 C<is_type TYPE>
492 Returns true if the order is of the given type.
494 =head2 C<convert_to_delivery_order %params>
496 Creates a new delivery order with C<$self> as the basis by calling
497 L<SL::DB::DeliveryOrder::new_from>. That delivery order is saved, and
498 C<$self> is linked to the new invoice via
499 L<SL::DB::RecordLink>. C<$self>'s C<delivered> attribute is set to
500 C<true>, and C<$self> is saved.
502 The arguments in C<%params> are passed to
503 L<SL::DB::DeliveryOrder::new_from>.
505 Returns C<undef> on failure. Otherwise the new delivery order will be
508 =head2 C<convert_to_invoice %params>
510 Creates a new invoice with C<$self> as the basis by calling
511 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
512 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
513 C<closed> attribute is set to C<true>, and C<$self> is saved.
515 The arguments in C<%params> are passed to L<SL::DB::Invoice::post>.
517 Returns the new invoice instance on success and C<undef> on
518 failure. The whole process is run inside a transaction. On failure
519 nothing is created or changed in the database.
521 At the moment only sales quotations and sales orders can be converted.
523 =head2 C<new_from $source, %params>
525 Creates a new C<SL::DB::Order> instance and copies as much
526 information from C<$source> as possible. At the moment only records with the
527 same destination type as the source type and sales orders from
528 sales quotations and purchase orders from requests for quotations can be
531 The C<transdate> field will be set to the current date.
533 The conversion copies the order items as well.
535 Returns the new order instance. The object returned is not
538 C<%params> can include the following options
539 (C<destination_type> is mandatory):
543 =item C<destination_type>
546 The type of the newly created object. Can be C<sales_quotation>,
547 C<sales_order>, C<purchase_quotation> or C<purchase_order> for now.
551 An optional array reference of RDBO instances for the items to use. If
552 missing then the method C<items_sorted> will be called on
553 C<$source>. This option can be used to override the sorting, to
554 exclude certain positions or to add additional ones.
556 =item C<skip_items_negative_qty>
558 If trueish then items with a negative quantity are skipped. Items with
559 a quantity of 0 are not affected by this option.
561 =item C<skip_items_zero_qty>
563 If trueish then items with a quantity of 0 are skipped.
567 An optional code reference that is called for each item with the item
568 as its sole parameter. Items for which the code reference returns a
569 falsish value will be skipped.
573 An optional hash reference. If it exists then it is passed to C<new>
574 allowing the caller to set certain attributes for the new delivery
579 =head2 C<new_from_multi $sources, %params>
581 Creates a new C<SL::DB::Order> instance from multiple sources and copies as
582 much information from C<$sources> as possible.
583 At the moment only sales orders can be combined and they must be of the same
586 The new order is created from the first one using C<new_from> and the positions
587 of all orders are added to the new order. The orders can be sorted with the
588 parameter C<sort_sources_by>.
590 The orders attributes are kept if they contain the same information for all
591 source orders an will be set to empty if they contain different information.
593 Returns the new order instance. The object returned is not
596 C<params> other then C<sort_sources_by> are passed to C<new_from>.
604 Sven Schöling <s.schoeling@linet-services.de>