S/D/Order: new_from/new_from_multi: Bearbeiter ist immer der aktuelle Benutzer
[kivitendo-erp.git] / SL / DB / Order.pm
1 package SL::DB::Order;
2
3 use utf8;
4 use strict;
5
6 use Carp;
7 use DateTime;
8 use List::Util qw(max);
9 use List::MoreUtils qw(any);
10
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);
22 use SL::RecordLinks;
23 use Rose::DB::Object::Helpers qw(as_tree);
24
25 __PACKAGE__->meta->add_relationship(
26   orderitems => {
27     type         => 'one to many',
28     class        => 'SL::DB::OrderItem',
29     column_map   => { id => 'trans_id' },
30     manager_args => {
31       with_objects => [ 'part' ]
32     }
33   },
34   periodic_invoices_config => {
35     type                   => 'one to one',
36     class                  => 'SL::DB::PeriodicInvoicesConfig',
37     column_map             => { id => 'oe_id' },
38   },
39   custom_shipto            => {
40     type                   => 'one to one',
41     class                  => 'SL::DB::Shipto',
42     column_map             => { id => 'trans_id' },
43     query_args             => [ module => 'OE' ],
44   },
45   exchangerate_obj         => {
46     type                   => 'one to one',
47     class                  => 'SL::DB::Exchangerate',
48     column_map             => { currency_id => 'currency_id', transdate => 'transdate' },
49   },
50 );
51
52 SL::DB::Helper::Attr::make(__PACKAGE__, daily_exchangerate => 'numeric');
53
54 __PACKAGE__->meta->initialize;
55
56 __PACKAGE__->attr_html('notes');
57 __PACKAGE__->attr_sorted('items');
58
59 __PACKAGE__->before_save('_before_save_set_ord_quo_number');
60 __PACKAGE__->before_save('_before_save_create_new_project');
61 __PACKAGE__->before_save('_before_save_remove_empty_custom_shipto');
62 __PACKAGE__->before_save('_before_save_set_custom_shipto_module');
63
64 # hooks
65
66 sub _before_save_set_ord_quo_number {
67   my ($self) = @_;
68
69   # ordnumber is 'NOT NULL'. Therefore make sure it's always set to at
70   # least an empty string, even if we're saving a quotation.
71   $self->ordnumber('') if !$self->ordnumber;
72
73   my $field = $self->quotation ? 'quonumber' : 'ordnumber';
74   $self->create_trans_number if !$self->$field;
75
76   return 1;
77 }
78 sub _before_save_create_new_project {
79   my ($self) = @_;
80
81   # force new project, if not set yet
82   if ($::instance_conf->get_order_always_project && !$self->globalproject_id && ($self->type eq 'sales_order')) {
83
84     die t8("Error while creating project with project number of new order number, project number #1 already exists!", $self->ordnumber)
85       if SL::DB::Manager::Project->find_by(projectnumber => $self->ordnumber);
86
87     eval {
88       my $new_project = SL::DB::Project->new(
89           projectnumber     => $self->ordnumber,
90           description       => $self->customer->name,
91           customer_id       => $self->customer->id,
92           active            => 1,
93           project_type_id   => $::instance_conf->get_project_type_id,
94           project_status_id => $::instance_conf->get_project_status_id,
95           );
96        $new_project->save;
97        $self->globalproject_id($new_project->id);
98     } or die t8('Could not create new project #1', $@);
99   }
100   return 1;
101 }
102
103
104 sub _before_save_remove_empty_custom_shipto {
105   my ($self) = @_;
106
107   $self->custom_shipto(undef) if $self->custom_shipto && $self->custom_shipto->is_empty;
108
109   return 1;
110 }
111
112 sub _before_save_set_custom_shipto_module {
113   my ($self) = @_;
114
115   $self->custom_shipto->module('OE') if $self->custom_shipto;
116
117   return 1;
118 }
119
120 # methods
121
122 sub items { goto &orderitems; }
123 sub add_items { goto &add_orderitems; }
124 sub record_number { goto &number; }
125
126 sub type {
127   my $self = shift;
128
129   return 'sales_order'       if $self->customer_id && ! $self->quotation;
130   return 'purchase_order'    if $self->vendor_id   && ! $self->quotation;
131   return 'sales_quotation'   if $self->customer_id &&   $self->quotation;
132   return 'request_quotation' if $self->vendor_id   &&   $self->quotation;
133
134   return;
135 }
136
137 sub is_type {
138   return shift->type eq shift;
139 }
140
141 sub deliverydate {
142   # oe doesn't have deliverydate, but it does have reqdate.
143   # But this has a different meaning for sales quotations.
144   # deliverydate can be used to determine tax if tax_point isn't set.
145
146   return $_[0]->reqdate if $_[0]->type ne 'sales_quotation';
147 }
148
149 sub effective_tax_point {
150   my ($self) = @_;
151
152   return $self->tax_point || $self->deliverydate || $self->transdate;
153 }
154
155 sub displayable_type {
156   my $type = shift->type;
157
158   return $::locale->text('Sales quotation')   if $type eq 'sales_quotation';
159   return $::locale->text('Request quotation') if $type eq 'request_quotation';
160   return $::locale->text('Sales Order')       if $type eq 'sales_order';
161   return $::locale->text('Purchase Order')    if $type eq 'purchase_order';
162
163   die 'invalid type';
164 }
165
166 sub displayable_name {
167   join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
168 };
169
170 sub is_sales {
171   croak 'not an accessor' if @_ > 1;
172   return !!shift->customer_id;
173 }
174
175 sub daily_exchangerate {
176   my ($self, $val) = @_;
177
178   return 1 if $self->currency_id == $::instance_conf->get_currency_id;
179
180   my $rate = (any { $self->is_type($_) } qw(sales_quotation sales_order))      ? 'buy'
181            : (any { $self->is_type($_) } qw(request_quotation purchase_order)) ? 'sell'
182            : undef;
183   return if !$rate;
184
185   if (defined $val) {
186     croak t8('exchange rate has to be positive') if $val <= 0;
187     if (!$self->exchangerate_obj) {
188       $self->exchangerate_obj(SL::DB::Exchangerate->new(
189         currency_id => $self->currency_id,
190         transdate   => $self->transdate,
191         $rate       => $val,
192       ));
193     } elsif (!defined $self->exchangerate_obj->$rate) {
194       $self->exchangerate_obj->$rate($val);
195     } else {
196       croak t8('exchange rate already exists, no update allowed');
197     }
198   }
199   return $self->exchangerate_obj->$rate if $self->exchangerate_obj;
200 }
201
202 sub invoices {
203   my $self   = shift;
204   my %params = @_;
205
206   if ($self->quotation) {
207     return [];
208   } else {
209     require SL::DB::Invoice;
210     return SL::DB::Manager::Invoice->get_all(
211       query => [
212         ordnumber => $self->ordnumber,
213         @{ $params{query} || [] },
214       ]
215     );
216   }
217 }
218
219 sub displayable_state {
220   my ($self) = @_;
221
222   return $self->closed ? $::locale->text('closed') : $::locale->text('open');
223 }
224
225 sub abschlag_invoices {
226   return shift()->invoices(query => [ abschlag => 1 ]);
227 }
228
229 sub end_invoice {
230   return shift()->invoices(query => [ abschlag => 0 ]);
231 }
232
233 sub convert_to_invoice {
234   my ($self, %params) = @_;
235
236   croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
237
238   my $invoice;
239   if (!$self->db->with_transaction(sub {
240     require SL::DB::Invoice;
241     $invoice = SL::DB::Invoice->new_from($self)->post(%params) || die;
242     $self->link_to_record($invoice);
243     $self->update_attributes(closed => 1);
244     1;
245   })) {
246     return undef;
247   }
248
249   return $invoice;
250 }
251
252 sub convert_to_delivery_order {
253   my ($self, @args) = @_;
254
255   my $delivery_order;
256   if (!$self->db->with_transaction(sub {
257     require SL::DB::DeliveryOrder;
258     $delivery_order = SL::DB::DeliveryOrder->new_from($self, @args);
259     $delivery_order->save;
260     $self->link_to_record($delivery_order);
261     # TODO extend link_to_record for items, otherwise long-term no d.r.y.
262     foreach my $item (@{ $delivery_order->items }) {
263       foreach (qw(orderitems)) {    # expand if needed (delivery_order_items)
264         if ($item->{"converted_from_${_}_id"}) {
265           die unless $item->{id};
266           RecordLinks->create_links('dbh'        => $self->db->dbh,
267                                     'mode'       => 'ids',
268                                     'from_table' => $_,
269                                     'from_ids'   => $item->{"converted_from_${_}_id"},
270                                     'to_table'   => 'delivery_order_items',
271                                     'to_id'      => $item->{id},
272           ) || die;
273           delete $item->{"converted_from_${_}_id"};
274         }
275       }
276     }
277
278     $self->update_attributes(delivered => 1) unless $::instance_conf->get_shipped_qty_require_stock_out;
279     1;
280   })) {
281     return undef;
282   }
283
284   return $delivery_order;
285 }
286
287 sub _clone_orderitem_cvar {
288   my ($cvar) = @_;
289
290   my $cloned = $_->clone_and_reset;
291   $cloned->sub_module('orderitems');
292
293   return $cloned;
294 }
295
296 sub new_from {
297   my ($class, $source, %params) = @_;
298
299   croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
300   croak("A destination type must be given as parameter")         unless $params{destination_type};
301
302   my $destination_type  = delete $params{destination_type};
303
304   my @from_tos = (
305     { from => 'sales_quotation',   to => 'sales_order',       abbr => 'sqso' },
306     { from => 'request_quotation', to => 'purchase_order',    abbr => 'rqpo' },
307     { from => 'sales_quotation',   to => 'sales_quotation',   abbr => 'sqsq' },
308     { from => 'sales_order',       to => 'sales_order',       abbr => 'soso' },
309     { from => 'request_quotation', to => 'request_quotation', abbr => 'rqrq' },
310     { from => 'purchase_order',    to => 'purchase_order',    abbr => 'popo' },
311     { from => 'sales_order',       to => 'purchase_order',    abbr => 'sopo' },
312     { from => 'purchase_order',    to => 'sales_order',       abbr => 'poso' },
313     { from => 'sales_order',       to => 'sales_quotation',   abbr => 'sosq' },
314     { from => 'purchase_order',    to => 'request_quotation', abbr => 'porq' },
315   );
316   my $from_to = (grep { $_->{from} eq $source->type && $_->{to} eq $destination_type} @from_tos)[0];
317   croak("Cannot convert from '" . $source->type . "' to '" . $destination_type . "'") if !$from_to;
318
319   my $is_abbr_any = sub {
320     any { $from_to->{abbr} eq $_ } @_;
321   };
322
323   my ($item_parent_id_column, $item_parent_column);
324
325   if (ref($source) eq 'SL::DB::Order') {
326     $item_parent_id_column = 'trans_id';
327     $item_parent_column    = 'order';
328   }
329
330   my %args = ( map({ ( $_ => $source->$_ ) } qw(amount cp_id currency_id cusordnumber customer_id delivery_customer_id delivery_term_id delivery_vendor_id
331                                                 department_id exchangerate globalproject_id intnotes marge_percent marge_total language_id netamount notes
332                                                 ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded tax_point taxzone_id
333                                                 transaction_description vendor_id
334                                              )),
335                quotation => !!($destination_type =~ m{quotation$}),
336                closed    => 0,
337                delivered => 0,
338                transdate => DateTime->today_local,
339                employee  => SL::DB::Manager::Employee->current,
340             );
341
342   if ( $is_abbr_any->(qw(sopo poso)) ) {
343     $args{ordnumber} = undef;
344     $args{quonumber} = undef;
345     $args{reqdate}   = DateTime->today_local->next_workday();
346   }
347   if ( $is_abbr_any->(qw(sopo)) ) {
348     $args{customer_id}      = undef;
349     $args{salesman_id}      = undef;
350     $args{payment_id}       = undef;
351     $args{delivery_term_id} = undef;
352   }
353   if ( $is_abbr_any->(qw(poso)) ) {
354     $args{vendor_id} = undef;
355   }
356   if ( $is_abbr_any->(qw(soso)) ) {
357     $args{periodic_invoices_config} = $source->periodic_invoices_config->clone_and_reset if $source->periodic_invoices_config;
358   }
359   if ( $is_abbr_any->(qw(sosq porq)) ) {
360     $args{ordnumber} = undef;
361     $args{quonumber} = undef;
362     $args{reqdate}   = DateTime->today_local->next_workday();
363   }
364
365   # Custom shipto addresses (the ones specific to the sales/purchase
366   # record and not to the customer/vendor) are only linked from
367   # shipto â†’ order. Meaning order.shipto_id
368   # will not be filled in that case.
369   if (!$source->shipto_id && $source->id) {
370     $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
371
372   } else {
373     $args{shipto_id} = $source->shipto_id;
374   }
375
376   my $order = $class->new(%args);
377   $order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
378   my $items = delete($params{items}) || $source->items_sorted;
379
380   my %item_parents;
381
382   my @items = map {
383     my $source_item      = $_;
384     my $source_item_id   = $_->$item_parent_id_column;
385     my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
386
387     $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
388     my $item_parent                  = $item_parents{$source_item_id};
389
390     my $current_oe_item = SL::DB::OrderItem->new(map({ ( $_ => $source_item->$_ ) }
391                                                      qw(active_discount_source active_price_source base_qty cusordnumber
392                                                         description discount lastcost longdescription
393                                                         marge_percent marge_price_factor marge_total
394                                                         ordnumber parts_id price_factor price_factor_id pricegroup_id
395                                                         project_id qty reqdate sellprice serialnumber ship subtotal transdate unit
396                                                         optional
397                                                      )),
398                                                  custom_variables => \@custom_variables,
399     );
400     if ( $is_abbr_any->(qw(sopo)) ) {
401       $current_oe_item->sellprice($source_item->lastcost);
402       $current_oe_item->discount(0);
403     }
404     if ( $is_abbr_any->(qw(poso)) ) {
405       $current_oe_item->lastcost($source_item->sellprice);
406     }
407     $current_oe_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
408     $current_oe_item;
409   } @{ $items };
410
411   @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
412   @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
413   @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
414
415   $order->items(\@items);
416
417   return $order;
418 }
419
420 sub new_from_multi {
421   my ($class, $sources, %params) = @_;
422
423   croak("Unsupported object type in sources")                             if any { ref($_) !~ m{SL::DB::Order} }                   @$sources;
424   croak("Cannot create order for purchase records")                       if any { !$_->is_sales }                                 @$sources;
425   croak("Cannot create order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
426
427   # bb: todo: check shipto: is it enough to check the ids or do we have to compare the entries?
428   if (delete $params{check_same_shipto}) {
429     die "check same shipto address is not implemented yet";
430     die "Source records do not have the same shipto"        if 1;
431   }
432
433   # sort sources
434   if (defined $params{sort_sources_by}) {
435     my $sort_by = delete $params{sort_sources_by};
436     if ($sources->[0]->can($sort_by)) {
437       $sources = [ sort { $a->$sort_by cmp $b->$sort_by } @$sources ];
438     } else {
439       die "Cannot sort source records by $sort_by";
440     }
441   }
442
443   # set this entries to undef that yield different information
444   my %attributes;
445   foreach my $attr (qw(ordnumber transdate reqdate tax_point taxincluded shippingpoint
446                        shipvia notes closed delivered reqdate quonumber
447                        cusordnumber proforma transaction_description
448                        order_probability expected_billing_date)) {
449     $attributes{$attr} = undef if any { ($sources->[0]->$attr//'') ne ($_->$attr//'') } @$sources;
450   }
451   foreach my $attr (qw(cp_id currency_id salesman_id department_id
452                        delivery_customer_id delivery_vendor_id shipto_id
453                        globalproject_id exchangerate)) {
454     $attributes{$attr} = undef if any { ($sources->[0]->$attr||0) != ($_->$attr||0) }   @$sources;
455   }
456
457   # set this entries from customer that yield different information
458   foreach my $attr (qw(language_id taxzone_id payment_id delivery_term_id)) {
459     $attributes{$attr}  = $sources->[0]->customervendor->$attr if any { ($sources->[0]->$attr||0)     != ($_->$attr||0) }      @$sources;
460   }
461   $attributes{intnotes} = $sources->[0]->customervendor->notes if any { ($sources->[0]->intnotes//'') ne ($_->intnotes//'')  } @$sources;
462
463   # no periodic invoice config for new order
464   $attributes{periodic_invoices_config} = undef;
465
466   # set emplyee to the current one
467   $attributes{employee} = SL::DB::Manager::Employee->current;
468
469   # copy global ordnumber, transdate, cusordnumber into item scope
470   #   unless already present there
471   foreach my $attr (qw(ordnumber transdate cusordnumber)) {
472     foreach my $src (@$sources) {
473       foreach my $item (@{ $src->items_sorted }) {
474         $item->$attr($src->$attr) if !$item->$attr;
475       }
476     }
477   }
478
479   # collect items
480   my @items;
481   push @items, @{$_->items_sorted} for @$sources;
482   # make order from first source and all items
483   my $order = $class->new_from($sources->[0],
484                                destination_type => 'sales_order',
485                                attributes       => \%attributes,
486                                items            => \@items,
487                                %params);
488
489   return $order;
490 }
491
492 sub number {
493   my $self = shift;
494
495   return if !$self->type;
496
497   my %number_method = (
498     sales_order       => 'ordnumber',
499     sales_quotation   => 'quonumber',
500     purchase_order    => 'ordnumber',
501     request_quotation => 'quonumber',
502   );
503
504   return $self->${ \ $number_method{$self->type} }(@_);
505 }
506
507 sub customervendor {
508   $_[0]->is_sales ? $_[0]->customer : $_[0]->vendor;
509 }
510
511 sub date {
512   goto &transdate;
513 }
514
515 sub digest {
516   my ($self) = @_;
517
518   sprintf "%s %s %s (%s)",
519     $self->number,
520     $self->customervendor->name,
521     $self->amount_as_number,
522     $self->date->to_kivitendo;
523 }
524
525 1;
526
527 __END__
528
529 =pod
530
531 =encoding utf8
532
533 =head1 NAME
534
535 SL::DB::Order - Order Datenbank Objekt.
536
537 =head1 FUNCTIONS
538
539 =head2 C<type>
540
541 Returns one of the following string types:
542
543 =over 4
544
545 =item sales_order
546
547 =item purchase_order
548
549 =item sales_quotation
550
551 =item request_quotation
552
553 =back
554
555 =head2 C<is_type TYPE>
556
557 Returns true if the order is of the given type.
558
559 =head2 C<daily_exchangerate $val>
560
561 Gets or sets the exchangerate object's value. This is the value from the
562 table C<exchangerate> depending on the order's currency, the transdate and
563 if it is a sales or purchase order.
564
565 The order object (respectively the table C<oe>) has an own column
566 C<exchangerate> which can be get or set with the accessor C<exchangerate>.
567
568 The idea is to drop the legacy table C<exchangerate> in the future and to
569 give all relevant tables it's own C<exchangerate> column.
570
571 So, this method is here if you need to access the "legacy" exchangerate via
572 an order object.
573
574 =over 4
575
576 =item C<$val>
577
578 (optional) If given, the exchangerate in the "legacy" table is set to this
579 value, depending on currency, transdate and sales or purchase.
580
581 =back
582
583 =head2 C<convert_to_delivery_order %params>
584
585 Creates a new delivery order with C<$self> as the basis by calling
586 L<SL::DB::DeliveryOrder::new_from>. That delivery order is saved, and
587 C<$self> is linked to the new invoice via
588 L<SL::DB::RecordLink>. C<$self>'s C<delivered> attribute is set to
589 C<true>, and C<$self> is saved.
590
591 The arguments in C<%params> are passed to
592 L<SL::DB::DeliveryOrder::new_from>.
593
594 Returns C<undef> on failure. Otherwise the new delivery order will be
595 returned.
596
597 =head2 C<convert_to_invoice %params>
598
599 Creates a new invoice with C<$self> as the basis by calling
600 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
601 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
602 C<closed> attribute is set to C<true>, and C<$self> is saved.
603
604 The arguments in C<%params> are passed to L<SL::DB::Invoice::post>.
605
606 Returns the new invoice instance on success and C<undef> on
607 failure. The whole process is run inside a transaction. On failure
608 nothing is created or changed in the database.
609
610 At the moment only sales quotations and sales orders can be converted.
611
612 =head2 C<new_from $source, %params>
613
614 Creates a new C<SL::DB::Order> instance and copies as much
615 information from C<$source> as possible. At the moment only records with the
616 same destination type as the source type and sales orders from
617 sales quotations and purchase orders from requests for quotations can be
618 created.
619
620 The C<transdate> field will be set to the current date.
621
622 The conversion copies the order items as well.
623
624 Returns the new order instance. The object returned is not
625 saved.
626
627 C<%params> can include the following options
628 (C<destination_type> is mandatory):
629
630 =over 4
631
632 =item C<destination_type>
633
634 (mandatory)
635 The type of the newly created object. Can be C<sales_quotation>,
636 C<sales_order>, C<purchase_quotation> or C<purchase_order> for now.
637
638 =item C<items>
639
640 An optional array reference of RDBO instances for the items to use. If
641 missing then the method C<items_sorted> will be called on
642 C<$source>. This option can be used to override the sorting, to
643 exclude certain positions or to add additional ones.
644
645 =item C<skip_items_negative_qty>
646
647 If trueish then items with a negative quantity are skipped. Items with
648 a quantity of 0 are not affected by this option.
649
650 =item C<skip_items_zero_qty>
651
652 If trueish then items with a quantity of 0 are skipped.
653
654 =item C<item_filter>
655
656 An optional code reference that is called for each item with the item
657 as its sole parameter. Items for which the code reference returns a
658 falsish value will be skipped.
659
660 =item C<attributes>
661
662 An optional hash reference. If it exists then it is passed to C<new>
663 allowing the caller to set certain attributes for the new delivery
664 order.
665
666 =back
667
668 =head2 C<new_from_multi $sources, %params>
669
670 Creates a new C<SL::DB::Order> instance from multiple sources and copies as
671 much information from C<$sources> as possible.
672 At the moment only sales orders can be combined and they must be of the same
673 customer.
674
675 The new order is created from the first one using C<new_from> and the positions
676 of all orders are added to the new order. The orders can be sorted with the
677 parameter C<sort_sources_by>.
678
679 The orders attributes are kept if they contain the same information for all
680 source orders an will be set to empty if they contain different information.
681
682 Returns the new order instance. The object returned is not
683 saved.
684
685 C<params> other then C<sort_sources_by> are passed to C<new_from>.
686
687 =head1 BUGS
688
689 Nothing here yet.
690
691 =head1 AUTHOR
692
693 Sven Schöling <s.schoeling@linet-services.de>
694
695 =cut