f4e630148e5eb0fa35cab589842b0d7ca799a7a6
[kivitendo-erp.git] / DeliveryOrder.pm
1 package SL::DB::DeliveryOrder;
2
3 use strict;
4
5 use Carp;
6
7 use Rose::DB::Object::Helpers ();
8
9 use SL::DB::MetaSetup::DeliveryOrder;
10 use SL::DB::Manager::DeliveryOrder;
11 use SL::DB::Helper::AttrHTML;
12 use SL::DB::Helper::AttrSorted;
13 use SL::DB::Helper::FlattenToForm;
14 use SL::DB::Helper::LinkedRecords;
15 use SL::DB::Helper::TransNumberGenerator;
16
17 use SL::DB::Part;
18 use SL::DB::Unit;
19
20 use SL::Helper::Number qw(_format_total _round_total);
21
22 use List::Util qw(first);
23 use List::MoreUtils qw(any pairwise);
24 use Math::Round qw(nhimult);
25
26 __PACKAGE__->meta->add_relationship(orderitems => { type         => 'one to many',
27                                                     class        => 'SL::DB::DeliveryOrderItem',
28                                                     column_map   => { id => 'delivery_order_id' },
29                                                     manager_args => { with_objects => [ 'part' ] }
30                                                   },
31                                     custom_shipto => {
32                                       type        => 'one to one',
33                                       class       => 'SL::DB::Shipto',
34                                       column_map  => { id => 'trans_id' },
35                                       query_args  => [ module => 'DO' ],
36                                     },
37                                    );
38
39 __PACKAGE__->meta->initialize;
40
41 __PACKAGE__->attr_html('notes');
42 __PACKAGE__->attr_sorted('items');
43
44 __PACKAGE__->before_save('_before_save_set_donumber');
45
46 # hooks
47
48 sub _before_save_set_donumber {
49   my ($self) = @_;
50
51   $self->create_trans_number if !$self->donumber;
52
53   return 1;
54 }
55
56 # methods
57
58 sub items { goto &orderitems; }
59 sub add_items { goto &add_orderitems; }
60 sub payment_terms { goto &payment; }
61 sub record_number { goto &donumber; }
62
63 sub sales_order {
64   my $self   = shift;
65   my %params = @_;
66
67
68   require SL::DB::Order;
69   my $orders = SL::DB::Manager::Order->get_all(
70     query => [
71       ordnumber => $self->ordnumber,
72       @{ $params{query} || [] },
73     ],
74   );
75
76   return first { $_->is_type('sales_order') } @{ $orders };
77 }
78
79 sub type {
80   return shift->customer_id ? 'sales_delivery_order' : 'purchase_delivery_order';
81 }
82
83 sub displayable_type {
84   my $type = shift->type;
85
86   return $::locale->text('Sales Delivery Order')    if $type eq 'sales_delivery_order';
87   return $::locale->text('Purchase Delivery Order') if $type eq 'purchase_delivery_order';
88
89   die 'invalid type';
90 }
91
92 sub displayable_name {
93   join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
94 };
95
96 sub displayable_state {
97   my ($self) = @_;
98
99   return join '; ',
100     ($self->closed    ? $::locale->text('closed')    : $::locale->text('open')),
101     ($self->delivered ? $::locale->text('delivered') : $::locale->text('not delivered'));
102 }
103
104 sub date {
105   goto &transdate;
106 }
107
108 sub _clone_orderitem_cvar {
109   my ($cvar) = @_;
110
111   my $cloned = $_->clone_and_reset;
112   $cloned->sub_module('delivery_order_items');
113
114   return $cloned;
115 }
116
117 sub new_from {
118   my ($class, $source, %params) = @_;
119
120   croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
121
122   my ($item_parent_id_column, $item_parent_column);
123
124   if (ref($source) eq 'SL::DB::Order') {
125     $item_parent_id_column = 'trans_id';
126     $item_parent_column    = 'order';
127   }
128
129   my %args = ( map({ ( $_ => $source->$_ ) } qw(cp_id currency_id customer_id cusordnumber delivery_term_id department_id employee_id globalproject_id intnotes language_id notes
130                                                 ordnumber payment_id reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id transaction_description vendor_id billing_address_id
131                                              )),
132                closed    => 0,
133                is_sales  => !!$source->customer_id,
134                delivered => 0,
135                transdate => DateTime->today_local,
136             );
137
138   # Custom shipto addresses (the ones specific to the sales/purchase
139   # record and not to the customer/vendor) are only linked from
140   # shipto → delivery_orders. Meaning delivery_orders.shipto_id
141   # will not be filled in that case.
142   if (!$source->shipto_id && $source->id) {
143     $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
144
145   } else {
146     $args{shipto_id} = $source->shipto_id;
147   }
148
149   my $delivery_order = $class->new(%args);
150   $delivery_order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
151   my $items          = delete($params{items}) || $source->items_sorted;
152   my %item_parents;
153
154   my @items = map {
155     my $source_item      = $_;
156     my $source_item_id   = $_->$item_parent_id_column;
157     my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
158
159     $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
160     my $item_parent                  = $item_parents{$source_item_id};
161
162     my $current_do_item = SL::DB::DeliveryOrderItem->new(map({ ( $_ => $source_item->$_ ) }
163                                          qw(base_qty cusordnumber description discount lastcost longdescription marge_price_factor parts_id price_factor price_factor_id
164                                             project_id qty reqdate sellprice serialnumber transdate unit active_discount_source active_price_source
165                                          )),
166                                    custom_variables => \@custom_variables,
167                                    ordnumber        => ref($item_parent) eq 'SL::DB::Order' ? $item_parent->ordnumber : $source_item->ordnumber,
168                                  );
169     $current_do_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
170     $current_do_item;
171   } @{ $items };
172
173   @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
174   @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
175   @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
176
177   $delivery_order->items(\@items);
178
179   return $delivery_order;
180 }
181
182 sub new_from_time_recordings {
183   my ($class, $sources, %params) = @_;
184
185   croak("Unsupported object type in sources")                                      if any { ref($_) ne 'SL::DB::TimeRecording' }            @$sources;
186   croak("Cannot create delivery order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
187
188   # - one item per part (article)
189   # - qty is sum of duration
190   # - description goes to item longdescription
191   #  - ordered and summed by date
192   #  - each description goes to an ordered list
193   #  - (as time recording descriptions are formatted text by now, use stripped text)
194   #  - merge same descriptions
195   #
196
197   my $default_part_id  = $params{default_part_id}     ? $params{default_part_id}
198                        : $params{default_partnumber}  ? SL::DB::Manager::Part->find_by(partnumber => $params{default_partnumber})->id
199                        : undef;
200   my $override_part_id = $params{override_part_id}    ? $params{override_part_id}
201                        : $params{override_partnumber} ? SL::DB::Manager::Part->find_by(partnumber => $params{override_partnumber})->id
202                        : undef;
203
204   # check parts and collect entries
205   my %part_by_part_id;
206   my $entries;
207   foreach my $source (@$sources) {
208     next if !$source->duration;
209
210     my $part_id   = $override_part_id;
211     $part_id    ||= $source->part_id;
212     $part_id    ||= $default_part_id;
213
214     die 'article not found for entry "' . $source->displayable_times . '"' if !$part_id;
215
216     if (!$part_by_part_id{$part_id}) {
217       $part_by_part_id{$part_id} = SL::DB::Part->new(id => $part_id)->load;
218       die 'article unit must be time based for entry "' . $source->displayable_times . '"' if !$part_by_part_id{$part_id}->unit_obj->is_time_based;
219     }
220
221     my $date = $source->date->to_kivitendo;
222     $entries->{$part_id}->{$date}->{duration} += $params{rounding}
223                                                ? nhimult(0.25, ($source->duration_in_hours))
224                                                : _round_total($source->duration_in_hours);
225     # add content if not already in description
226     my $new_description = '' . $source->description_as_stripped_html;
227     $entries->{$part_id}->{$date}->{content} ||= '';
228     $entries->{$part_id}->{$date}->{content}  .= '<li>' . $new_description . '</li>'
229       unless $entries->{$part_id}->{$date}->{content} =~ m/\Q$new_description/;
230
231     $entries->{$part_id}->{$date}->{date_obj}  = $source->start_time || $source->date; # for sorting
232   }
233
234   my @items;
235
236   my $h_unit = SL::DB::Manager::Unit->find_h_unit;
237
238   my @keys = sort { $part_by_part_id{$a}->partnumber cmp $part_by_part_id{$b}->partnumber } keys %$entries;
239   foreach my $key (@keys) {
240     my $qty = 0;
241     my $longdescription = '';
242
243     my @dates = sort { $entries->{$key}->{$a}->{date_obj} <=> $entries->{$key}->{$b}->{date_obj} } keys %{$entries->{$key}};
244     foreach my $date (@dates) {
245       my $entry = $entries->{$key}->{$date};
246
247       $qty             += $entry->{duration};
248       $longdescription .= $date . ' <strong>' . _format_total($entry->{duration}) . ' h</strong>';
249       $longdescription .= '<ul>';
250       $longdescription .= $entry->{content};
251       $longdescription .= '</ul>';
252     }
253
254     my $item = SL::DB::DeliveryOrderItem->new(
255       parts_id        => $part_by_part_id{$key}->id,
256       description     => $part_by_part_id{$key}->description,
257       qty             => $qty,
258       base_qty        => $h_unit->convert_to($qty, $part_by_part_id{$key}->unit_obj),
259       unit_obj        => $h_unit,
260       sellprice       => $part_by_part_id{$key}->sellprice, # Todo: use price rules to get sellprice
261       longdescription => $longdescription,
262     );
263
264     push @items, $item;
265   }
266
267   my $delivery_order;
268
269   if ($params{related_order}) {
270     # collect suitable items in related order
271     my @items_to_use;
272     my @new_attributes;
273     foreach my $item (@items) {
274       my $item_to_use = first {$item->parts_id == $_->parts_id} @{ $params{related_order}->items_sorted };
275
276       die "no suitable item found in related order" if !$item_to_use;
277
278       my %new_attributes;
279       $new_attributes{$_} = $item->$_ for qw(qty base_qty unit_obj longdescription);
280       push @items_to_use,   $item_to_use;
281       push @new_attributes, \%new_attributes;
282     }
283
284     $delivery_order = $class->new_from($params{related_order}, items => \@items_to_use, %params);
285     pairwise { $a->assign_attributes( %$b) } @{$delivery_order->items}, @new_attributes;
286
287   } else {
288     my %args = (
289       is_sales    => 1,
290       delivered   => 0,
291       customer_id => $sources->[0]->customer_id,
292       taxzone_id  => $sources->[0]->customer->taxzone_id,
293       currency_id => $sources->[0]->customer->currency_id,
294       employee_id => SL::DB::Manager::Employee->current->id,
295       salesman_id => SL::DB::Manager::Employee->current->id,
296       items       => \@items,
297     );
298     $delivery_order = $class->new(%args);
299     $delivery_order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
300   }
301
302   return $delivery_order;
303 }
304
305 sub customervendor {
306   $_[0]->is_sales ? $_[0]->customer : $_[0]->vendor;
307 }
308
309 sub convert_to_invoice {
310   my ($self, %params) = @_;
311
312   croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
313
314   my $invoice;
315   if (!$self->db->with_transaction(sub {
316     require SL::DB::Invoice;
317     $invoice = SL::DB::Invoice->new_from($self, %params)->post || die;
318     $self->link_to_record($invoice);
319     # TODO extend link_to_record for items, otherwise long-term no d.r.y.
320     foreach my $item (@{ $invoice->items }) {
321       foreach (qw(delivery_order_items)) {    # expand if needed (orderitems)
322         if ($item->{"converted_from_${_}_id"}) {
323           die unless $item->{id};
324           RecordLinks->create_links('mode'       => 'ids',
325                                     'from_table' => $_,
326                                     'from_ids'   => $item->{"converted_from_${_}_id"},
327                                     'to_table'   => 'invoice',
328                                     'to_id'      => $item->{id},
329           ) || die;
330           delete $item->{"converted_from_${_}_id"};
331         }
332       }
333     }
334     $self->update_attributes(closed => 1);
335     1;
336   })) {
337     return undef;
338   }
339
340   return $invoice;
341 }
342
343 sub digest {
344   my ($self) = @_;
345
346   sprintf "%s %s (%s)",
347     $self->donumber,
348     $self->customervendor->name,
349     $self->date->to_kivitendo;
350 }
351
352 1;
353 __END__
354
355 =pod
356
357 =encoding utf8
358
359 =head1 NAME
360
361 SL::DB::DeliveryOrder - Rose model for delivery orders (table
362 "delivery_orders")
363
364 =head1 FUNCTIONS
365
366 =over 4
367
368 =item C<date>
369
370 An alias for C<transdate> for compatibility with other sales/purchase models.
371
372 =item C<displayable_name>
373
374 Returns a human-readable and translated description of the delivery order, consisting of
375 record type and number, e.g. "Verkaufslieferschein 123".
376
377 =item C<displayable_state>
378
379 Returns a human-readable description of the state regarding being
380 closed and delivered.
381
382 =item C<items>
383
384 An alias for C<delivery_order_items> for compatibility with other
385 sales/purchase models.
386
387 =item C<new_from $source, %params>
388
389 Creates a new C<SL::DB::DeliveryOrder> instance and copies as much
390 information from C<$source> as possible. At the moment only instances
391 of C<SL::DB::Order> (sales quotations, sales orders, requests for
392 quotations and purchase orders) are supported as sources.
393
394 The conversion copies order items into delivery order items. Dates are copied
395 as appropriate, e.g. the C<transdate> field will be set to the current date.
396
397 Returns the new delivery order instance. The object returned is not
398 saved.
399
400 C<%params> can include the following options:
401
402 =over 2
403
404 =item C<items>
405
406 An optional array reference of RDBO instances for the items to use. If
407 missing then the method C<items_sorted> will be called on
408 C<$source>. This option can be used to override the sorting, to
409 exclude certain positions or to add additional ones.
410
411 =item C<skip_items_negative_qty>
412
413 If trueish then items with a negative quantity are skipped. Items with
414 a quantity of 0 are not affected by this option.
415
416 =item C<skip_items_zero_qty>
417
418 If trueish then items with a quantity of 0 are skipped.
419
420 =item C<item_filter>
421
422 An optional code reference that is called for each item with the item
423 as its sole parameter. Items for which the code reference returns a
424 falsish value will be skipped.
425
426 =item C<attributes>
427
428 An optional hash reference. If it exists then it is passed to C<new>
429 allowing the caller to set certain attributes for the new delivery
430 order.
431
432 =back
433
434 =item C<new_from_time_recordings $sources, %params>
435
436 Creates a new C<SL::DB::DeliveryOrder> instance from the time recordings
437 given as C<$sources>. All time recording entries must belong to the same
438 customer. Time recordings are sorted by article and date. For each article
439 a new delivery order item is created. If no article is associated with an
440 entry, a default article will be used. The article given in the time
441 recording entry can be overriden.
442 Entries of the same date (for each article) are summed together and form a
443 list entry in the long description of the item.
444
445 The created delivery order object will be returnd but not saved.
446
447 C<$sources> must be an array reference of C<SL::DB::TimeRecording> instances.
448
449 C<%params> can include the following options:
450
451 =over 2
452
453 =item C<attributes>
454
455 An optional hash reference. If it exists then it is used to set
456 attributes of the newly created delivery order object.
457
458 =item C<default_part_id>
459
460 An optional part id which is used as default value if no part is set
461 in the time recording entry.
462
463 =item C<default_partnumber>
464
465 Like C<default_part_id> but given as partnumber, not as id.
466
467 =item C<override_part_id>
468
469 An optional part id which is used instead of a value set in the time
470 recording entry.
471
472 =item C<override_partnumber>
473
474 Like C<overrride_part_id> but given as partnumber, not as id.
475
476 =item C<related_order>
477
478 An optional C<SL::DB::Order> object. If it exists then it is used to
479 generate the delivery order from that via C<new_from>.
480 The generated items are created from a suitable item of the related
481 order. If no suitable item is found, an exception is thrown.
482
483 =item C<rounding>
484
485 An optional boolean value. If truish, then the durations of the time entries
486 are rounded up to the full quarters of an hour.
487
488 =back
489
490 =item C<sales_order>
491
492 TODO: Describe sales_order
493
494 =item C<type>
495
496 Returns a string describing this record's type: either
497 C<sales_delivery_order> or C<purchase_delivery_order>.
498
499 =item C<convert_to_invoice %params>
500
501 Creates a new invoice with C<$self> as the basis by calling
502 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
503 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
504 C<closed> attribute is set to C<true>, and C<$self> is saved.
505
506 The arguments in C<%params> are passed to L<SL::DB::Invoice::new_from>.
507
508 Returns the new invoice instance on success and C<undef> on
509 failure. The whole process is run inside a transaction. On failure
510 nothing is created or changed in the database.
511
512 At the moment only sales delivery orders can be converted.
513
514 =back
515
516 =head1 BUGS
517
518 Nothing here yet.
519
520 =head1 AUTHOR
521
522 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
523
524 =cut