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');
64 sub _before_save_set_ord_quo_number {
67 # ordnumber is 'NOT NULL'. Therefore make sure it's always set to at
68 # least an empty string, even if we're saving a quotation.
69 $self->ordnumber('') if !$self->ordnumber;
71 my $field = $self->quotation ? 'quonumber' : 'ordnumber';
72 $self->create_trans_number if !$self->$field;
76 sub _before_save_create_new_project {
79 # force new project, if not set yet
80 if ($::instance_conf->get_order_always_project && !$self->globalproject_id && ($self->type eq 'sales_order')) {
82 die t8("Error while creating project with project number of new order number, project number #1 already exists!", $self->ordnumber)
83 if SL::DB::Manager::Project->find_by(projectnumber => $self->ordnumber);
86 my $new_project = SL::DB::Project->new(
87 projectnumber => $self->ordnumber,
88 description => $self->customer->name,
89 customer_id => $self->customer->id,
91 project_type_id => $::instance_conf->get_project_type_id,
92 project_status_id => $::instance_conf->get_project_status_id,
95 $self->globalproject_id($new_project->id);
96 } or die t8('Could not create new project #1', $@);
103 sub items { goto &orderitems; }
104 sub add_items { goto &add_orderitems; }
105 sub record_number { goto &number; }
110 return 'sales_order' if $self->customer_id && ! $self->quotation;
111 return 'purchase_order' if $self->vendor_id && ! $self->quotation;
112 return 'sales_quotation' if $self->customer_id && $self->quotation;
113 return 'request_quotation' if $self->vendor_id && $self->quotation;
119 return shift->type eq shift;
123 # oe doesn't have deliverydate, but PTC checks for deliverydate or transdate to determine tax
124 # oe can't deal with deviating tax rates, but at least make sure PTC doesn't barf
125 return shift->transdate;
128 sub displayable_type {
129 my $type = shift->type;
131 return $::locale->text('Sales quotation') if $type eq 'sales_quotation';
132 return $::locale->text('Request quotation') if $type eq 'request_quotation';
133 return $::locale->text('Sales Order') if $type eq 'sales_order';
134 return $::locale->text('Purchase Order') if $type eq 'purchase_order';
139 sub displayable_name {
140 join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
144 croak 'not an accessor' if @_ > 1;
145 return !!shift->customer_id;
148 sub daily_exchangerate {
149 my ($self, $val) = @_;
151 return 1 if $self->currency_id == $::instance_conf->get_currency_id;
153 my $rate = (any { $self->is_type($_) } qw(sales_quotation sales_order)) ? 'buy'
154 : (any { $self->is_type($_) } qw(request_quotation purchase_order)) ? 'sell'
159 croak t8('exchange rate has to be positive') if $val <= 0;
160 if (!$self->exchangerate_obj) {
161 $self->exchangerate_obj(SL::DB::Exchangerate->new(
162 currency_id => $self->currency_id,
163 transdate => $self->transdate,
166 } elsif (!defined $self->exchangerate_obj->$rate) {
167 $self->exchangerate_obj->$rate($val);
169 croak t8('exchange rate already exists, no update allowed');
172 return $self->exchangerate_obj->$rate if $self->exchangerate_obj;
179 if ($self->quotation) {
182 require SL::DB::Invoice;
183 return SL::DB::Manager::Invoice->get_all(
185 ordnumber => $self->ordnumber,
186 @{ $params{query} || [] },
192 sub displayable_state {
195 return $self->closed ? $::locale->text('closed') : $::locale->text('open');
198 sub abschlag_invoices {
199 return shift()->invoices(query => [ abschlag => 1 ]);
203 return shift()->invoices(query => [ abschlag => 0 ]);
206 sub convert_to_invoice {
207 my ($self, %params) = @_;
209 croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
212 if (!$self->db->with_transaction(sub {
213 require SL::DB::Invoice;
214 $invoice = SL::DB::Invoice->new_from($self)->post(%params) || die;
215 $self->link_to_record($invoice);
216 $self->update_attributes(closed => 1);
225 sub convert_to_delivery_order {
226 my ($self, @args) = @_;
229 if (!$self->db->with_transaction(sub {
230 require SL::DB::DeliveryOrder;
231 $delivery_order = SL::DB::DeliveryOrder->new_from($self, @args);
232 $delivery_order->save;
233 $self->link_to_record($delivery_order);
234 # TODO extend link_to_record for items, otherwise long-term no d.r.y.
235 foreach my $item (@{ $delivery_order->items }) {
236 foreach (qw(orderitems)) { # expand if needed (delivery_order_items)
237 if ($item->{"converted_from_${_}_id"}) {
238 die unless $item->{id};
239 RecordLinks->create_links('dbh' => $self->db->dbh,
242 'from_ids' => $item->{"converted_from_${_}_id"},
243 'to_table' => 'delivery_order_items',
244 'to_id' => $item->{id},
246 delete $item->{"converted_from_${_}_id"};
251 $self->update_attributes(delivered => 1);
257 return $delivery_order;
260 sub _clone_orderitem_cvar {
263 my $cloned = $_->clone_and_reset;
264 $cloned->sub_module('orderitems');
270 my ($class, $source, %params) = @_;
272 croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
273 croak("A destination type must be given as parameter") unless $params{destination_type};
275 my $destination_type = delete $params{destination_type};
278 { from => 'sales_quotation', to => 'sales_order', abbr => 'sqso' },
279 { from => 'request_quotation', to => 'purchase_order', abbr => 'rqpo' },
280 { from => 'sales_quotation', to => 'sales_quotation', abbr => 'sqsq' },
281 { from => 'sales_order', to => 'sales_order', abbr => 'soso' },
282 { from => 'request_quotation', to => 'request_quotation', abbr => 'rqrq' },
283 { from => 'purchase_order', to => 'purchase_order', abbr => 'popo' },
284 { from => 'sales_order', to => 'purchase_order', abbr => 'sopo' },
285 { from => 'purchase_order', to => 'sales_order', abbr => 'poso' },
287 my $from_to = (grep { $_->{from} eq $source->type && $_->{to} eq $destination_type} @from_tos)[0];
288 croak("Cannot convert from '" . $source->type . "' to '" . $destination_type . "'") if !$from_to;
290 my $is_abbr_any = sub {
291 # foreach my $abbr (@_) {
292 # croak "no such abbreviation: '$abbr'" if !grep { $_->{abbr} eq $abbr } @from_tos;
294 any { $from_to->{abbr} eq $_ } @_;
297 my ($item_parent_id_column, $item_parent_column);
299 if (ref($source) eq 'SL::DB::Order') {
300 $item_parent_id_column = 'trans_id';
301 $item_parent_column = 'order';
304 my %args = ( map({ ( $_ => $source->$_ ) } qw(amount cp_id currency_id cusordnumber customer_id delivery_customer_id delivery_term_id delivery_vendor_id
305 department_id employee_id exchangerate globalproject_id intnotes marge_percent marge_total language_id netamount notes
306 ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id
307 transaction_description vendor_id
309 quotation => !!($destination_type =~ m{quotation$}),
312 transdate => DateTime->today_local,
315 if ( $is_abbr_any->(qw(sopo poso)) ) {
316 $args{ordnumber} = undef;
317 $args{reqdate} = DateTime->today_local->next_workday();
318 $args{employee} = SL::DB::Manager::Employee->current;
320 if ( $is_abbr_any->(qw(sopo)) ) {
321 $args{customer_id} = undef;
322 $args{salesman_id} = undef;
323 $args{payment_id} = undef;
324 $args{delivery_term_id} = undef;
326 if ( $is_abbr_any->(qw(poso)) ) {
327 $args{vendor_id} = undef;
329 if ( $is_abbr_any->(qw(soso)) ) {
330 $args{periodic_invoices_config} = $source->periodic_invoices_config->clone_and_reset if $source->periodic_invoices_config;
333 # Custom shipto addresses (the ones specific to the sales/purchase
334 # record and not to the customer/vendor) are only linked from
335 # shipto → order. Meaning order.shipto_id
336 # will not be filled in that case.
337 if (!$source->shipto_id && $source->id) {
338 $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
341 $args{shipto_id} = $source->shipto_id;
344 my $order = $class->new(%args);
345 $order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
346 my $items = delete($params{items}) || $source->items_sorted;
351 my $source_item = $_;
352 my $source_item_id = $_->$item_parent_id_column;
353 my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
355 $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
356 my $item_parent = $item_parents{$source_item_id};
358 my $current_oe_item = SL::DB::OrderItem->new(map({ ( $_ => $source_item->$_ ) }
359 qw(active_discount_source active_price_source base_qty cusordnumber
360 description discount lastcost longdescription
361 marge_percent marge_price_factor marge_total
362 ordnumber parts_id price_factor price_factor_id pricegroup_id
363 project_id qty reqdate sellprice serialnumber ship subtotal transdate unit
365 custom_variables => \@custom_variables,
367 if ( $is_abbr_any->(qw(sopo)) ) {
368 $current_oe_item->sellprice($source_item->lastcost);
369 $current_oe_item->discount(0);
371 if ( $is_abbr_any->(qw(poso)) ) {
372 $current_oe_item->lastcost($source_item->sellprice);
374 $current_oe_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
378 @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
379 @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
380 @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
382 $order->items(\@items);
388 my ($class, $sources, %params) = @_;
390 croak("Unsupported object type in sources") if any { ref($_) !~ m{SL::DB::Order} } @$sources;
391 croak("Cannot create order for purchase records") if any { !$_->is_sales } @$sources;
392 croak("Cannot create order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
394 # bb: todo: check shipto: is it enough to check the ids or do we have to compare the entries?
395 if (delete $params{check_same_shipto}) {
396 die "check same shipto address is not implemented yet";
397 die "Source records do not have the same shipto" if 1;
401 if (defined $params{sort_sources_by}) {
402 my $sort_by = delete $params{sort_sources_by};
403 if ($sources->[0]->can($sort_by)) {
404 $sources = [ sort { $a->$sort_by cmp $b->$sort_by } @$sources ];
406 die "Cannot sort source records by $sort_by";
410 # set this entries to undef that yield different information
412 foreach my $attr (qw(ordnumber transdate reqdate taxincluded shippingpoint
413 shipvia notes closed delivered reqdate quonumber
414 cusordnumber proforma transaction_description
415 order_probability expected_billing_date)) {
416 $attributes{$attr} = undef if any { ($sources->[0]->$attr//'') ne ($_->$attr//'') } @$sources;
418 foreach my $attr (qw(cp_id currency_id employee_id salesman_id department_id
419 delivery_customer_id delivery_vendor_id shipto_id
420 globalproject_id exchangerate)) {
421 $attributes{$attr} = undef if any { ($sources->[0]->$attr||0) != ($_->$attr||0) } @$sources;
424 # set this entries from customer that yield different information
425 foreach my $attr (qw(language_id taxzone_id payment_id delivery_term_id)) {
426 $attributes{$attr} = $sources->[0]->customervendor->$attr if any { ($sources->[0]->$attr||0) != ($_->$attr||0) } @$sources;
428 $attributes{intnotes} = $sources->[0]->customervendor->notes if any { ($sources->[0]->intnotes//'') ne ($_->intnotes//'') } @$sources;
430 # no periodic invoice config for new order
431 $attributes{periodic_invoices_config} = undef;
433 # copy global ordnumber, transdate, cusordnumber into item scope
434 # unless already present there
435 foreach my $attr (qw(ordnumber transdate cusordnumber)) {
436 foreach my $src (@$sources) {
437 foreach my $item (@{ $src->items_sorted }) {
438 $item->$attr($src->$attr) if !$item->$attr;
445 push @items, @{$_->items_sorted} for @$sources;
446 # make order from first source and all items
447 my $order = $class->new_from($sources->[0],
448 destination_type => 'sales_order',
449 attributes => \%attributes,
459 return if !$self->type;
461 my %number_method = (
462 sales_order => 'ordnumber',
463 sales_quotation => 'quonumber',
464 purchase_order => 'ordnumber',
465 request_quotation => 'quonumber',
468 return $self->${ \ $number_method{$self->type} }(@_);
472 $_[0]->is_sales ? $_[0]->customer : $_[0]->vendor;
482 sprintf "%s %s %s (%s)",
484 $self->customervendor->name,
485 $self->amount_as_number,
486 $self->date->to_kivitendo;
499 SL::DB::Order - Order Datenbank Objekt.
505 Returns one of the following string types:
513 =item sales_quotation
515 =item request_quotation
519 =head2 C<is_type TYPE>
521 Returns true if the order is of the given type.
523 =head2 C<daily_exchangerate $val>
525 Gets or sets the exchangerate object's value. This is the value from the
526 table C<exchangerate> depending on the order's currency, the transdate and
527 if it is a sales or purchase order.
529 The order object (respectively the table C<oe>) has an own column
530 C<exchangerate> which can be get or set with the accessor C<exchangerate>.
532 The idea is to drop the legacy table C<exchangerate> in the future and to
533 give all relevant tables it's own C<exchangerate> column.
535 So, this method is here if you need to access the "legacy" exchangerate via
542 (optional) If given, the exchangerate in the "legacy" table is set to this
543 value, depending on currency, transdate and sales or purchase.
547 =head2 C<convert_to_delivery_order %params>
549 Creates a new delivery order with C<$self> as the basis by calling
550 L<SL::DB::DeliveryOrder::new_from>. That delivery order is saved, and
551 C<$self> is linked to the new invoice via
552 L<SL::DB::RecordLink>. C<$self>'s C<delivered> attribute is set to
553 C<true>, and C<$self> is saved.
555 The arguments in C<%params> are passed to
556 L<SL::DB::DeliveryOrder::new_from>.
558 Returns C<undef> on failure. Otherwise the new delivery order will be
561 =head2 C<convert_to_invoice %params>
563 Creates a new invoice with C<$self> as the basis by calling
564 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
565 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
566 C<closed> attribute is set to C<true>, and C<$self> is saved.
568 The arguments in C<%params> are passed to L<SL::DB::Invoice::post>.
570 Returns the new invoice instance on success and C<undef> on
571 failure. The whole process is run inside a transaction. On failure
572 nothing is created or changed in the database.
574 At the moment only sales quotations and sales orders can be converted.
576 =head2 C<new_from $source, %params>
578 Creates a new C<SL::DB::Order> instance and copies as much
579 information from C<$source> as possible. At the moment only records with the
580 same destination type as the source type and sales orders from
581 sales quotations and purchase orders from requests for quotations can be
584 The C<transdate> field will be set to the current date.
586 The conversion copies the order items as well.
588 Returns the new order instance. The object returned is not
591 C<%params> can include the following options
592 (C<destination_type> is mandatory):
596 =item C<destination_type>
599 The type of the newly created object. Can be C<sales_quotation>,
600 C<sales_order>, C<purchase_quotation> or C<purchase_order> for now.
604 An optional array reference of RDBO instances for the items to use. If
605 missing then the method C<items_sorted> will be called on
606 C<$source>. This option can be used to override the sorting, to
607 exclude certain positions or to add additional ones.
609 =item C<skip_items_negative_qty>
611 If trueish then items with a negative quantity are skipped. Items with
612 a quantity of 0 are not affected by this option.
614 =item C<skip_items_zero_qty>
616 If trueish then items with a quantity of 0 are skipped.
620 An optional code reference that is called for each item with the item
621 as its sole parameter. Items for which the code reference returns a
622 falsish value will be skipped.
626 An optional hash reference. If it exists then it is passed to C<new>
627 allowing the caller to set certain attributes for the new delivery
632 =head2 C<new_from_multi $sources, %params>
634 Creates a new C<SL::DB::Order> instance from multiple sources and copies as
635 much information from C<$sources> as possible.
636 At the moment only sales orders can be combined and they must be of the same
639 The new order is created from the first one using C<new_from> and the positions
640 of all orders are added to the new order. The orders can be sorted with the
641 parameter C<sort_sources_by>.
643 The orders attributes are kept if they contain the same information for all
644 source orders an will be set to empty if they contain different information.
646 Returns the new order instance. The object returned is not
649 C<params> other then C<sort_sources_by> are passed to C<new_from>.
657 Sven Schöling <s.schoeling@linet-services.de>