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