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::AttrHTML;
14 use SL::DB::Helper::AttrSorted;
15 use SL::DB::Helper::FlattenToForm;
16 use SL::DB::Helper::LinkedRecords;
17 use SL::DB::Helper::PriceTaxCalculator;
18 use SL::DB::Helper::PriceUpdater;
19 use SL::DB::Helper::TransNumberGenerator;
21 use Rose::DB::Object::Helpers qw(as_tree);
23 __PACKAGE__->meta->add_relationship(
25 type => 'one to many',
26 class => 'SL::DB::OrderItem',
27 column_map => { id => 'trans_id' },
29 with_objects => [ 'part' ]
32 periodic_invoices_config => {
34 class => 'SL::DB::PeriodicInvoicesConfig',
35 column_map => { id => 'oe_id' },
39 class => 'SL::DB::Shipto',
40 column_map => { id => 'trans_id' },
41 query_args => [ module => 'OE' ],
45 __PACKAGE__->meta->initialize;
47 __PACKAGE__->attr_html('notes');
48 __PACKAGE__->attr_sorted('items');
50 __PACKAGE__->before_save('_before_save_set_ord_quo_number');
54 sub _before_save_set_ord_quo_number {
57 # ordnumber is 'NOT NULL'. Therefore make sure it's always set to at
58 # least an empty string, even if we're saving a quotation.
59 $self->ordnumber('') if !$self->ordnumber;
61 my $field = $self->quotation ? 'quonumber' : 'ordnumber';
62 $self->create_trans_number if !$self->$field;
69 sub items { goto &orderitems; }
70 sub add_items { goto &add_orderitems; }
71 sub record_number { goto &number; }
76 return 'sales_order' if $self->customer_id && ! $self->quotation;
77 return 'purchase_order' if $self->vendor_id && ! $self->quotation;
78 return 'sales_quotation' if $self->customer_id && $self->quotation;
79 return 'request_quotation' if $self->vendor_id && $self->quotation;
85 return shift->type eq shift;
89 # oe doesn't have deliverydate, but PTC checks for deliverydate or transdate to determine tax
90 # oe can't deal with deviating tax rates, but at least make sure PTC doesn't barf
91 return shift->transdate;
94 sub displayable_type {
95 my $type = shift->type;
97 return $::locale->text('Sales quotation') if $type eq 'sales_quotation';
98 return $::locale->text('Request quotation') if $type eq 'request_quotation';
99 return $::locale->text('Sales Order') if $type eq 'sales_order';
100 return $::locale->text('Purchase Order') if $type eq 'purchase_order';
105 sub displayable_name {
106 join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
110 croak 'not an accessor' if @_ > 1;
111 return !!shift->customer_id;
118 if ($self->quotation) {
121 require SL::DB::Invoice;
122 return SL::DB::Manager::Invoice->get_all(
124 ordnumber => $self->ordnumber,
125 @{ $params{query} || [] },
131 sub displayable_state {
134 return $self->closed ? $::locale->text('closed') : $::locale->text('open');
137 sub abschlag_invoices {
138 return shift()->invoices(query => [ abschlag => 1 ]);
142 return shift()->invoices(query => [ abschlag => 0 ]);
145 sub convert_to_invoice {
146 my ($self, %params) = @_;
148 croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
151 if (!$self->db->with_transaction(sub {
152 require SL::DB::Invoice;
153 $invoice = SL::DB::Invoice->new_from($self)->post(%params) || die;
154 $self->link_to_record($invoice);
155 $self->update_attributes(closed => 1);
164 sub convert_to_delivery_order {
165 my ($self, @args) = @_;
168 if (!$self->db->with_transaction(sub {
169 require SL::DB::DeliveryOrder;
170 $delivery_order = SL::DB::DeliveryOrder->new_from($self, @args);
171 $delivery_order->save;
172 $self->link_to_record($delivery_order);
173 # TODO extend link_to_record for items, otherwise long-term no d.r.y.
174 foreach my $item (@{ $delivery_order->items }) {
175 foreach (qw(orderitems)) { # expand if needed (delivery_order_items)
176 if ($item->{"converted_from_${_}_id"}) {
177 die unless $item->{id};
178 RecordLinks->create_links('dbh' => $self->db->dbh,
181 'from_ids' => $item->{"converted_from_${_}_id"},
182 'to_table' => 'delivery_order_items',
183 'to_id' => $item->{id},
185 delete $item->{"converted_from_${_}_id"};
190 $self->update_attributes(delivered => 1);
196 return $delivery_order;
199 sub _clone_orderitem_cvar {
202 my $cloned = $_->clone_and_reset;
203 $cloned->sub_module('orderitems');
209 my ($class, $source, %params) = @_;
211 croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
212 croak("A destination type must be given as parameter") unless $params{destination_type};
214 my $destination_type = delete $params{destination_type};
217 { from => 'sales_quotation', to => 'sales_order', abbr => 'sqso' },
218 { from => 'request_quotation', to => 'purchase_order', abbr => 'rqpo' },
219 { from => 'sales_quotation', to => 'sales_quotation', abbr => 'sqsq' },
220 { from => 'sales_order', to => 'sales_order', abbr => 'soso' },
221 { from => 'request_quotation', to => 'request_quotation', abbr => 'rqrq' },
222 { from => 'purchase_order', to => 'purchase_order', abbr => 'popo' },
223 { from => 'sales_order', to => 'purchase_order', abbr => 'sopo' },
224 { from => 'purchase_order', to => 'sales_order', abbr => 'poso' },
226 my $from_to = (grep { $_->{from} eq $source->type && $_->{to} eq $destination_type} @from_tos)[0];
227 croak("Cannot convert from '" . $source->type . "' to '" . $destination_type . "'") if !$from_to;
229 my $is_abbr_any = sub {
230 # foreach my $abbr (@_) {
231 # croak "no such abbreviation: '$abbr'" if !grep { $_->{abbr} eq $abbr } @from_tos;
233 any { $from_to->{abbr} eq $_ } @_;
236 my ($item_parent_id_column, $item_parent_column);
238 if (ref($source) eq 'SL::DB::Order') {
239 $item_parent_id_column = 'trans_id';
240 $item_parent_column = 'order';
243 my %args = ( map({ ( $_ => $source->$_ ) } qw(amount cp_id currency_id cusordnumber customer_id delivery_customer_id delivery_term_id delivery_vendor_id
244 department_id employee_id globalproject_id intnotes marge_percent marge_total language_id netamount notes
245 ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id
246 transaction_description vendor_id
248 quotation => !!($destination_type =~ m{quotation$}),
251 transdate => DateTime->today_local,
254 if ( $is_abbr_any->(qw(sopo poso)) ) {
255 $args{ordnumber} = undef;
256 $args{reqdate} = DateTime->today_local->next_workday();
257 $args{employee} = SL::DB::Manager::Employee->current;
259 if ( $is_abbr_any->(qw(sopo)) ) {
260 $args{customer_id} = undef;
261 $args{salesman_id} = undef;
262 $args{payment_id} = undef;
263 $args{delivery_term_id} = undef;
265 if ( $is_abbr_any->(qw(poso)) ) {
266 $args{vendor_id} = undef;
268 if ( $is_abbr_any->(qw(soso)) ) {
269 $args{periodic_invoices_config} = $source->periodic_invoices_config->clone_and_reset if $source->periodic_invoices_config;
272 # Custom shipto addresses (the ones specific to the sales/purchase
273 # record and not to the customer/vendor) are only linked from
274 # shipto → order. Meaning order.shipto_id
275 # will not be filled in that case.
276 if (!$source->shipto_id && $source->id) {
277 $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
280 $args{shipto_id} = $source->shipto_id;
283 my $order = $class->new(%args);
284 $order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
285 my $items = delete($params{items}) || $source->items_sorted;
290 my $source_item = $_;
291 my $source_item_id = $_->$item_parent_id_column;
292 my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
294 $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
295 my $item_parent = $item_parents{$source_item_id};
297 my $current_oe_item = SL::DB::OrderItem->new(map({ ( $_ => $source_item->$_ ) }
298 qw(active_discount_source active_price_source base_qty cusordnumber
299 description discount lastcost longdescription
300 marge_percent marge_price_factor marge_total
301 ordnumber parts_id price_factor price_factor_id pricegroup_id
302 project_id qty reqdate sellprice serialnumber ship subtotal transdate unit
304 custom_variables => \@custom_variables,
306 if ( $is_abbr_any->(qw(sopo)) ) {
307 $current_oe_item->sellprice($source_item->lastcost);
308 $current_oe_item->discount(0);
310 if ( $is_abbr_any->(qw(poso)) ) {
311 $current_oe_item->lastcost($source_item->sellprice);
313 $current_oe_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
317 @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
318 @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
319 @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
321 $order->items(\@items);
327 my ($class, $sources, %params) = @_;
329 croak("Unsupported object type in sources") if any { ref($_) !~ m{SL::DB::Order} } @$sources;
330 croak("Cannot create order for purchase records") if any { !$_->is_sales } @$sources;
331 croak("Cannot create order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
333 # bb: todo: check shipto: is it enough to check the ids or do we have to compare the entries?
334 if (delete $params{check_same_shipto}) {
335 die "check same shipto address is not implemented yet";
336 die "Source records do not have the same shipto" if 1;
340 if (defined $params{sort_sources_by}) {
341 my $sort_by = delete $params{sort_sources_by};
342 if ($sources->[0]->can($sort_by)) {
343 $sources = [ sort { $a->$sort_by cmp $b->$sort_by } @$sources ];
345 die "Cannot sort source records by $sort_by";
349 # set this entries to undef that yield different information
351 foreach my $attr (qw(ordnumber transdate reqdate taxincluded shippingpoint
352 shipvia notes closed delivered reqdate quonumber
353 cusordnumber proforma transaction_description
354 order_probability expected_billing_date)) {
355 $attributes{$attr} = undef if any { ($sources->[0]->$attr//'') ne ($_->$attr//'') } @$sources;
357 foreach my $attr (qw(cp_id currency_id employee_id salesman_id department_id
358 delivery_customer_id delivery_vendor_id shipto_id
360 $attributes{$attr} = undef if any { ($sources->[0]->$attr||0) != ($_->$attr||0) } @$sources;
363 # set this entries from customer that yield different information
364 foreach my $attr (qw(language_id taxzone_id payment_id delivery_term_id)) {
365 $attributes{$attr} = $sources->[0]->customervendor->$attr if any { ($sources->[0]->$attr||0) != ($_->$attr||0) } @$sources;
367 $attributes{intnotes} = $sources->[0]->customervendor->notes if any { ($sources->[0]->intnotes//'') ne ($_->intnotes//'') } @$sources;
369 # no periodic invoice config for new order
370 $attributes{periodic_invoices_config} = undef;
372 # copy global ordnumber, transdate, cusordnumber into item scope
373 # unless already present there
374 foreach my $attr (qw(ordnumber transdate cusordnumber)) {
375 foreach my $src (@$sources) {
376 foreach my $item (@{ $src->items_sorted }) {
377 $item->$attr($src->$attr) if !$item->$attr;
384 push @items, @{$_->items_sorted} for @$sources;
385 # make order from first source and all items
386 my $order = $class->new_from($sources->[0],
387 destination_type => 'sales_order',
388 attributes => \%attributes,
398 return if !$self->type;
400 my %number_method = (
401 sales_order => 'ordnumber',
402 sales_quotation => 'quonumber',
403 purchase_order => 'ordnumber',
404 request_quotation => 'quonumber',
407 return $self->${ \ $number_method{$self->type} }(@_);
411 $_[0]->is_sales ? $_[0]->customer : $_[0]->vendor;
421 sprintf "%s %s %s (%s)",
423 $self->customervendor->name,
424 $self->amount_as_number,
425 $self->date->to_kivitendo;
438 SL::DB::Order - Order Datenbank Objekt.
444 Returns one of the following string types:
452 =item sales_quotation
454 =item request_quotation
458 =head2 C<is_type TYPE>
460 Returns true if the order is of the given type.
462 =head2 C<convert_to_delivery_order %params>
464 Creates a new delivery order with C<$self> as the basis by calling
465 L<SL::DB::DeliveryOrder::new_from>. That delivery order is saved, and
466 C<$self> is linked to the new invoice via
467 L<SL::DB::RecordLink>. C<$self>'s C<delivered> attribute is set to
468 C<true>, and C<$self> is saved.
470 The arguments in C<%params> are passed to
471 L<SL::DB::DeliveryOrder::new_from>.
473 Returns C<undef> on failure. Otherwise the new delivery order will be
476 =head2 C<convert_to_invoice %params>
478 Creates a new invoice with C<$self> as the basis by calling
479 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
480 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
481 C<closed> attribute is set to C<true>, and C<$self> is saved.
483 The arguments in C<%params> are passed to L<SL::DB::Invoice::post>.
485 Returns the new invoice instance on success and C<undef> on
486 failure. The whole process is run inside a transaction. On failure
487 nothing is created or changed in the database.
489 At the moment only sales quotations and sales orders can be converted.
491 =head2 C<new_from $source, %params>
493 Creates a new C<SL::DB::Order> instance and copies as much
494 information from C<$source> as possible. At the moment only records with the
495 same destination type as the source type and sales orders from
496 sales quotations and purchase orders from requests for quotations can be
499 The C<transdate> field will be set to the current date.
501 The conversion copies the order items as well.
503 Returns the new order instance. The object returned is not
506 C<%params> can include the following options
507 (C<destination_type> is mandatory):
511 =item C<destination_type>
514 The type of the newly created object. Can be C<sales_quotation>,
515 C<sales_order>, C<purchase_quotation> or C<purchase_order> for now.
519 An optional array reference of RDBO instances for the items to use. If
520 missing then the method C<items_sorted> will be called on
521 C<$source>. This option can be used to override the sorting, to
522 exclude certain positions or to add additional ones.
524 =item C<skip_items_negative_qty>
526 If trueish then items with a negative quantity are skipped. Items with
527 a quantity of 0 are not affected by this option.
529 =item C<skip_items_zero_qty>
531 If trueish then items with a quantity of 0 are skipped.
535 An optional code reference that is called for each item with the item
536 as its sole parameter. Items for which the code reference returns a
537 falsish value will be skipped.
541 An optional hash reference. If it exists then it is passed to C<new>
542 allowing the caller to set certain attributes for the new delivery
547 =head2 C<new_from_multi $sources, %params>
549 Creates a new C<SL::DB::Order> instance from multiple sources and copies as
550 much information from C<$sources> as possible.
551 At the moment only sales orders can be combined and they must be of the same
554 The new order is created from the first one using C<new_from> and the positions
555 of all orders are added to the new order. The orders can be sorted with the
556 parameter C<sort_sources_by>.
558 The orders attributes are kept if they contain the same information for all
559 source orders an will be set to empty if they contain different information.
561 Returns the new order instance. The object returned is not
564 C<params> other then C<sort_sources_by> are passed to C<new_from>.
572 Sven Schöling <s.schoeling@linet-services.de>