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;
88 sub displayable_type {
89 my $type = shift->type;
91 return $::locale->text('Sales quotation') if $type eq 'sales_quotation';
92 return $::locale->text('Request quotation') if $type eq 'request_quotation';
93 return $::locale->text('Sales Order') if $type eq 'sales_order';
94 return $::locale->text('Purchase Order') if $type eq 'purchase_order';
99 sub displayable_name {
100 join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
104 croak 'not an accessor' if @_ > 1;
105 return !!shift->customer_id;
112 if ($self->quotation) {
115 require SL::DB::Invoice;
116 return SL::DB::Manager::Invoice->get_all(
118 ordnumber => $self->ordnumber,
119 @{ $params{query} || [] },
125 sub displayable_state {
128 return $self->closed ? $::locale->text('closed') : $::locale->text('open');
131 sub abschlag_invoices {
132 return shift()->invoices(query => [ abschlag => 1 ]);
136 return shift()->invoices(query => [ abschlag => 0 ]);
139 sub convert_to_invoice {
140 my ($self, %params) = @_;
142 croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
145 if (!$self->db->with_transaction(sub {
146 require SL::DB::Invoice;
147 $invoice = SL::DB::Invoice->new_from($self)->post(%params) || die;
148 $self->link_to_record($invoice);
149 $self->update_attributes(closed => 1);
158 sub convert_to_delivery_order {
159 my ($self, @args) = @_;
162 if (!$self->db->with_transaction(sub {
163 require SL::DB::DeliveryOrder;
164 $delivery_order = SL::DB::DeliveryOrder->new_from($self, @args);
165 $delivery_order->save;
166 $self->link_to_record($delivery_order);
167 # TODO extend link_to_record for items, otherwise long-term no d.r.y.
168 foreach my $item (@{ $delivery_order->items }) {
169 foreach (qw(orderitems)) { # expand if needed (delivery_order_items)
170 if ($item->{"converted_from_${_}_id"}) {
171 die unless $item->{id};
172 RecordLinks->create_links('dbh' => $self->db->dbh,
175 'from_ids' => $item->{"converted_from_${_}_id"},
176 'to_table' => 'delivery_order_items',
177 'to_id' => $item->{id},
179 delete $item->{"converted_from_${_}_id"};
184 $self->update_attributes(delivered => 1);
190 return $delivery_order;
193 sub _clone_orderitem_cvar {
196 my $cloned = $_->clone_and_reset;
197 $cloned->sub_module('orderitems');
203 my ($class, $source, %params) = @_;
205 croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
206 croak("A destination type must be given as parameter") unless $params{destination_type};
208 my $destination_type = delete $params{destination_type};
211 { from => 'sales_quotation', to => 'sales_order', abbr => 'sqso' },
212 { from => 'request_quotation', to => 'purchase_order', abbr => 'rqpo' },
213 { from => 'sales_quotation', to => 'sales_quotation', abbr => 'sqsq' },
214 { from => 'sales_order', to => 'sales_order', abbr => 'soso' },
215 { from => 'request_quotation', to => 'request_quotation', abbr => 'rqrq' },
216 { from => 'purchase_order', to => 'purchase_order', abbr => 'popo' },
217 { from => 'sales_order', to => 'purchase_order', abbr => 'sopo' },
218 { from => 'purchase_order', to => 'sales_order', abbr => 'poso' },
220 my $from_to = (grep { $_->{from} eq $source->type && $_->{to} eq $destination_type} @from_tos)[0];
221 croak("Cannot convert from '" . $source->type . "' to '" . $destination_type . "'") if !$from_to;
223 my $is_abbr_any = sub {
224 # foreach my $abbr (@_) {
225 # croak "no such abbreviation: '$abbr'" if !grep { $_->{abbr} eq $abbr } @from_tos;
227 any { $from_to->{abbr} eq $_ } @_;
230 my ($item_parent_id_column, $item_parent_column);
232 if (ref($source) eq 'SL::DB::Order') {
233 $item_parent_id_column = 'trans_id';
234 $item_parent_column = 'order';
237 my %args = ( map({ ( $_ => $source->$_ ) } qw(amount cp_id currency_id cusordnumber customer_id delivery_customer_id delivery_term_id delivery_vendor_id
238 department_id employee_id globalproject_id intnotes marge_percent marge_total language_id netamount notes
239 ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id
240 transaction_description vendor_id
242 quotation => !!($destination_type =~ m{quotation$}),
245 transdate => DateTime->today_local,
248 if ( $is_abbr_any->(qw(sopo poso)) ) {
249 $args{ordnumber} = undef;
250 $args{reqdate} = DateTime->today_local->next_workday();
251 $args{employee} = SL::DB::Manager::Employee->current;
253 if ( $is_abbr_any->(qw(sopo)) ) {
254 $args{customer_id} = undef;
255 $args{salesman_id} = undef;
256 $args{payment_id} = undef;
257 $args{delivery_term_id} = undef;
259 if ( $is_abbr_any->(qw(poso)) ) {
260 $args{vendor_id} = undef;
262 if ( $is_abbr_any->(qw(soso)) ) {
263 $args{periodic_invoices_config} = $source->periodic_invoices_config->clone_and_reset if $source->periodic_invoices_config;
266 # Custom shipto addresses (the ones specific to the sales/purchase
267 # record and not to the customer/vendor) are only linked from
268 # shipto → order. Meaning order.shipto_id
269 # will not be filled in that case.
270 if (!$source->shipto_id && $source->id) {
271 $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
274 $args{shipto_id} = $source->shipto_id;
277 my $order = $class->new(%args);
278 $order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
279 my $items = delete($params{items}) || $source->items_sorted;
284 my $source_item = $_;
285 my $source_item_id = $_->$item_parent_id_column;
286 my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
288 $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
289 my $item_parent = $item_parents{$source_item_id};
291 my $current_oe_item = SL::DB::OrderItem->new(map({ ( $_ => $source_item->$_ ) }
292 qw(active_discount_source active_price_source base_qty cusordnumber
293 description discount lastcost longdescription
294 marge_percent marge_price_factor marge_total
295 ordnumber parts_id price_factor price_factor_id pricegroup_id
296 project_id qty reqdate sellprice serialnumber ship subtotal transdate unit
298 custom_variables => \@custom_variables,
300 if ( $is_abbr_any->(qw(sopo)) ) {
301 $current_oe_item->sellprice($source_item->lastcost);
302 $current_oe_item->discount(0);
304 if ( $is_abbr_any->(qw(poso)) ) {
305 $current_oe_item->lastcost($source_item->sellprice);
307 $current_oe_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
311 @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
312 @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
313 @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
315 $order->items(\@items);
321 my ($class, $sources, %params) = @_;
323 croak("Unsupported object type in sources") if any { ref($_) !~ m{SL::DB::Order} } @$sources;
324 croak("Cannot create order for purchase records") if any { !$_->is_sales } @$sources;
325 croak("Cannot create order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
327 # bb: todo: check shipto: is it enough to check the ids or do we have to compare the entries?
328 if (delete $params{check_same_shipto}) {
329 die "check same shipto address is not implemented yet";
330 die "Source records do not have the same shipto" if 1;
334 if (defined $params{sort_sources_by}) {
335 my $sort_by = delete $params{sort_sources_by};
336 if ($sources->[0]->can($sort_by)) {
337 $sources = [ sort { $a->$sort_by cmp $b->$sort_by } @$sources ];
339 die "Cannot sort source records by $sort_by";
343 # set this entries to undef that yield different information
345 foreach my $attr (qw(ordnumber transdate reqdate taxincluded shippingpoint
346 shipvia notes closed delivered reqdate quonumber
347 cusordnumber proforma transaction_description
348 order_probability expected_billing_date)) {
349 $attributes{$attr} = undef if any { ($sources->[0]->$attr//'') ne ($_->$attr//'') } @$sources;
351 foreach my $attr (qw(cp_id currency_id employee_id salesman_id department_id
352 delivery_customer_id delivery_vendor_id shipto_id
354 $attributes{$attr} = undef if any { ($sources->[0]->$attr||0) != ($_->$attr||0) } @$sources;
357 # set this entries from customer that yield different information
358 foreach my $attr (qw(language_id taxzone_id payment_id delivery_term_id)) {
359 $attributes{$attr} = $sources->[0]->customervendor->$attr if any { ($sources->[0]->$attr||0) != ($_->$attr||0) } @$sources;
361 $attributes{intnotes} = $sources->[0]->customervendor->notes if any { ($sources->[0]->intnotes//'') ne ($_->intnotes//'') } @$sources;
363 # no periodic invoice config for new order
364 $attributes{periodic_invoices_config} = undef;
366 # copy global ordnumber, transdate, cusordnumber into item scope
367 # unless already present there
368 foreach my $attr (qw(ordnumber transdate cusordnumber)) {
369 foreach my $src (@$sources) {
370 foreach my $item (@{ $src->items_sorted }) {
371 $item->$attr($src->$attr) if !$item->$attr;
378 push @items, @{$_->items_sorted} for @$sources;
379 # make order from first source and all items
380 my $order = $class->new_from($sources->[0],
381 destination_type => 'sales_order',
382 attributes => \%attributes,
392 return if !$self->type;
394 my %number_method = (
395 sales_order => 'ordnumber',
396 sales_quotation => 'quonumber',
397 purchase_order => 'ordnumber',
398 request_quotation => 'quonumber',
401 return $self->${ \ $number_method{$self->type} }(@_);
405 $_[0]->is_sales ? $_[0]->customer : $_[0]->vendor;
415 sprintf "%s %s %s (%s)",
417 $self->customervendor->name,
418 $self->amount_as_number,
419 $self->date->to_kivitendo;
432 SL::DB::Order - Order Datenbank Objekt.
438 Returns one of the following string types:
446 =item sales_quotation
448 =item request_quotation
452 =head2 C<is_type TYPE>
454 Returns true if the order is of the given type.
456 =head2 C<convert_to_delivery_order %params>
458 Creates a new delivery order with C<$self> as the basis by calling
459 L<SL::DB::DeliveryOrder::new_from>. That delivery order is saved, and
460 C<$self> is linked to the new invoice via
461 L<SL::DB::RecordLink>. C<$self>'s C<delivered> attribute is set to
462 C<true>, and C<$self> is saved.
464 The arguments in C<%params> are passed to
465 L<SL::DB::DeliveryOrder::new_from>.
467 Returns C<undef> on failure. Otherwise the new delivery order will be
470 =head2 C<convert_to_invoice %params>
472 Creates a new invoice with C<$self> as the basis by calling
473 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
474 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
475 C<closed> attribute is set to C<true>, and C<$self> is saved.
477 The arguments in C<%params> are passed to L<SL::DB::Invoice::post>.
479 Returns the new invoice instance on success and C<undef> on
480 failure. The whole process is run inside a transaction. On failure
481 nothing is created or changed in the database.
483 At the moment only sales quotations and sales orders can be converted.
485 =head2 C<new_from $source, %params>
487 Creates a new C<SL::DB::Order> instance and copies as much
488 information from C<$source> as possible. At the moment only records with the
489 same destination type as the source type and sales orders from
490 sales quotations and purchase orders from requests for quotations can be
493 The C<transdate> field will be set to the current date.
495 The conversion copies the order items as well.
497 Returns the new order instance. The object returned is not
500 C<%params> can include the following options
501 (C<destination_type> is mandatory):
505 =item C<destination_type>
508 The type of the newly created object. Can be C<sales_quotation>,
509 C<sales_order>, C<purchase_quotation> or C<purchase_order> for now.
513 An optional array reference of RDBO instances for the items to use. If
514 missing then the method C<items_sorted> will be called on
515 C<$source>. This option can be used to override the sorting, to
516 exclude certain positions or to add additional ones.
518 =item C<skip_items_negative_qty>
520 If trueish then items with a negative quantity are skipped. Items with
521 a quantity of 0 are not affected by this option.
523 =item C<skip_items_zero_qty>
525 If trueish then items with a quantity of 0 are skipped.
529 An optional code reference that is called for each item with the item
530 as its sole parameter. Items for which the code reference returns a
531 falsish value will be skipped.
535 An optional hash reference. If it exists then it is passed to C<new>
536 allowing the caller to set certain attributes for the new delivery
541 =head2 C<new_from_multi $sources, %params>
543 Creates a new C<SL::DB::Order> instance from multiple sources and copies as
544 much information from C<$sources> as possible.
545 At the moment only sales orders can be combined and they must be of the same
548 The new order is created from the first one using C<new_from> and the positions
549 of all orders are added to the new order. The orders can be sorted with the
550 parameter C<sort_sources_by>.
552 The orders attributes are kept if they contain the same information for all
553 source orders an will be set to empty if they contain different information.
555 Returns the new order instance. The object returned is not
558 C<params> other then C<sort_sources_by> are passed to C<new_from>.
566 Sven Schöling <s.schoeling@linet-services.de>