1 package SL::DB::DeliveryOrder;
7 use Rose::DB::Object::Helpers ();
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;
20 use SL::DB::DeliveryOrder::TypeData qw(:types);
22 use SL::Helper::Number qw(_format_total _round_total);
24 use List::Util qw(first);
25 use List::MoreUtils qw(any pairwise);
26 use Math::Round qw(nhimult);
28 __PACKAGE__->meta->add_relationship(orderitems => { type => 'one to many',
29 class => 'SL::DB::DeliveryOrderItem',
30 column_map => { id => 'delivery_order_id' },
31 manager_args => { with_objects => [ 'part' ] }
35 class => 'SL::DB::Shipto',
36 column_map => { id => 'trans_id' },
37 query_args => [ module => 'DO' ],
41 __PACKAGE__->meta->initialize;
43 __PACKAGE__->attr_html('notes');
44 __PACKAGE__->attr_sorted('items');
46 __PACKAGE__->before_save('_before_save_set_donumber');
50 sub _before_save_set_donumber {
53 $self->create_trans_number if !$self->donumber;
60 sub items { goto &orderitems; }
61 sub add_items { goto &add_orderitems; }
62 sub payment_terms { goto &payment; }
63 sub record_number { goto &donumber; }
70 require SL::DB::Order;
71 my $orders = SL::DB::Manager::Order->get_all(
73 ordnumber => $self->ordnumber,
74 @{ $params{query} || [] },
78 return first { $_->is_type('sales_order') } @{ $orders };
86 return shift->type eq shift;
89 sub displayable_type {
90 my $type = shift->type;
92 return $::locale->text('Sales Delivery Order') if $type eq 'sales_delivery_order';
93 return $::locale->text('Purchase Delivery Order') if $type eq 'purchase_delivery_order';
98 sub displayable_name {
99 join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
102 sub displayable_state {
106 ($self->closed ? $::locale->text('closed') : $::locale->text('open')),
107 ($self->delivered ? $::locale->text('delivered') : $::locale->text('not delivered'));
118 sub _clone_orderitem_cvar {
121 my $cloned = $_->clone_and_reset;
122 $cloned->sub_module('delivery_order_items');
128 my ($class, $source, %params) = @_;
130 croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
132 my ($item_parent_id_column, $item_parent_column);
134 if (ref($source) eq 'SL::DB::Order') {
135 $item_parent_id_column = 'trans_id';
136 $item_parent_column = 'order';
139 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
140 ordnumber payment_id reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id transaction_description vendor_id billing_address_id
144 order_type => $params{type},
145 transdate => DateTime->today_local,
148 # Custom shipto addresses (the ones specific to the sales/purchase
149 # record and not to the customer/vendor) are only linked from
150 # shipto → delivery_orders. Meaning delivery_orders.shipto_id
151 # will not be filled in that case.
152 if (!$source->shipto_id && $source->id) {
153 $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
156 $args{shipto_id} = $source->shipto_id;
159 # infer type from legacy fields if not given
160 $args{order_type} //= $source->customer_id ? 'sales_delivery_order'
161 : $source->vendor_id ? 'purchase_delivery_order'
162 : $source->is_sales ? 'sales_delivery_order'
163 : croak "need some way to set delivery order type from source";
165 my $delivery_order = $class->new(%args);
166 $delivery_order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
167 my $items = delete($params{items}) || $source->items_sorted;
170 # do not copy items when converting to supplier delivery order
171 my @items = $delivery_order->is_type(SUPPLIER_DELIVERY_ORDER_TYPE) ? () : map {
172 my $source_item = $_;
173 my $source_item_id = $_->$item_parent_id_column;
174 my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
176 $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
177 my $item_parent = $item_parents{$source_item_id};
179 my $current_do_item = SL::DB::DeliveryOrderItem->new(map({ ( $_ => $source_item->$_ ) }
180 qw(base_qty cusordnumber description discount lastcost longdescription marge_price_factor parts_id price_factor price_factor_id
181 project_id qty reqdate sellprice serialnumber transdate unit active_discount_source active_price_source
183 custom_variables => \@custom_variables,
184 ordnumber => ref($item_parent) eq 'SL::DB::Order' ? $item_parent->ordnumber : $source_item->ordnumber,
186 $current_do_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
190 @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
191 @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
192 @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
194 $delivery_order->items(\@items);
196 return $delivery_order;
199 sub new_from_time_recordings {
200 my ($class, $sources, %params) = @_;
202 croak("Unsupported object type in sources") if any { ref($_) ne 'SL::DB::TimeRecording' } @$sources;
203 croak("Cannot create delivery order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
205 # - one item per part (article)
206 # - qty is sum of duration
207 # - description goes to item longdescription
208 # - ordered and summed by date
209 # - each description goes to an ordered list
210 # - (as time recording descriptions are formatted text by now, use stripped text)
211 # - merge same descriptions
214 my $default_part_id = $params{default_part_id} ? $params{default_part_id}
215 : $params{default_partnumber} ? SL::DB::Manager::Part->find_by(partnumber => $params{default_partnumber})->id
217 my $override_part_id = $params{override_part_id} ? $params{override_part_id}
218 : $params{override_partnumber} ? SL::DB::Manager::Part->find_by(partnumber => $params{override_partnumber})->id
221 # check parts and collect entries
224 foreach my $source (@$sources) {
225 next if !$source->duration;
227 my $part_id = $override_part_id;
228 $part_id ||= $source->part_id;
229 $part_id ||= $default_part_id;
231 die 'article not found for entry "' . $source->displayable_times . '"' if !$part_id;
233 if (!$part_by_part_id{$part_id}) {
234 $part_by_part_id{$part_id} = SL::DB::Part->new(id => $part_id)->load;
235 die 'article unit must be time based for entry "' . $source->displayable_times . '"' if !$part_by_part_id{$part_id}->unit_obj->is_time_based;
238 my $date = $source->date->to_kivitendo;
239 $entries->{$part_id}->{$date}->{duration} += $params{rounding}
240 ? nhimult(0.25, ($source->duration_in_hours))
241 : _round_total($source->duration_in_hours);
242 # add content if not already in description
243 my $new_description = '' . $source->description_as_stripped_html;
244 $entries->{$part_id}->{$date}->{content} ||= '';
245 $entries->{$part_id}->{$date}->{content} .= '<li>' . $new_description . '</li>'
246 unless $entries->{$part_id}->{$date}->{content} =~ m/\Q$new_description/;
248 $entries->{$part_id}->{$date}->{date_obj} = $source->start_time || $source->date; # for sorting
253 my $h_unit = SL::DB::Manager::Unit->find_h_unit;
255 my @keys = sort { $part_by_part_id{$a}->partnumber cmp $part_by_part_id{$b}->partnumber } keys %$entries;
256 foreach my $key (@keys) {
258 my $longdescription = '';
260 my @dates = sort { $entries->{$key}->{$a}->{date_obj} <=> $entries->{$key}->{$b}->{date_obj} } keys %{$entries->{$key}};
261 foreach my $date (@dates) {
262 my $entry = $entries->{$key}->{$date};
264 $qty += $entry->{duration};
265 $longdescription .= $date . ' <strong>' . _format_total($entry->{duration}) . ' h</strong>';
266 $longdescription .= '<ul>';
267 $longdescription .= $entry->{content};
268 $longdescription .= '</ul>';
271 my $item = SL::DB::DeliveryOrderItem->new(
272 parts_id => $part_by_part_id{$key}->id,
273 description => $part_by_part_id{$key}->description,
275 base_qty => $h_unit->convert_to($qty, $part_by_part_id{$key}->unit_obj),
277 sellprice => $part_by_part_id{$key}->sellprice, # Todo: use price rules to get sellprice
278 longdescription => $longdescription,
286 if ($params{related_order}) {
287 # collect suitable items in related order
290 foreach my $item (@items) {
291 my $item_to_use = first {$item->parts_id == $_->parts_id} @{ $params{related_order}->items_sorted };
293 die "no suitable item found in related order" if !$item_to_use;
296 $new_attributes{$_} = $item->$_ for qw(qty base_qty unit_obj longdescription);
297 push @items_to_use, $item_to_use;
298 push @new_attributes, \%new_attributes;
301 $delivery_order = $class->new_from($params{related_order}, items => \@items_to_use, %params);
302 pairwise { $a->assign_attributes( %$b) } @{$delivery_order->items}, @new_attributes;
307 order_type => 'sales_delivery_order',
309 customer_id => $sources->[0]->customer_id,
310 taxzone_id => $sources->[0]->customer->taxzone_id,
311 currency_id => $sources->[0]->customer->currency_id,
312 employee_id => SL::DB::Manager::Employee->current->id,
313 salesman_id => SL::DB::Manager::Employee->current->id,
316 $delivery_order = $class->new(%args);
317 $delivery_order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
320 return $delivery_order;
323 # legacy for compatibility
324 # use type_data cusomtervendor and transfer direction instead
326 if ($_[0]->order_type) {
327 return SL::DB::DeliveryOrder::TypeData::get3($_[0]->order_type, "properties", "is_customer");
329 return $_[0]{is_sales};
333 SL::DB::DeliveryOrder::TypeData::get3($_[0]->order_type, "properties", "is_customer") ? $_[0]->customer : $_[0]->vendor;
336 sub convert_to_invoice {
337 my ($self, %params) = @_;
339 croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
342 if (!$self->db->with_transaction(sub {
343 require SL::DB::Invoice;
344 $invoice = SL::DB::Invoice->new_from($self, %params)->post || die;
345 $self->link_to_record($invoice);
346 # TODO extend link_to_record for items, otherwise long-term no d.r.y.
347 foreach my $item (@{ $invoice->items }) {
348 foreach (qw(delivery_order_items)) { # expand if needed (orderitems)
349 if ($item->{"converted_from_${_}_id"}) {
350 die unless $item->{id};
351 RecordLinks->create_links('mode' => 'ids',
353 'from_ids' => $item->{"converted_from_${_}_id"},
354 'to_table' => 'invoice',
355 'to_id' => $item->{id},
357 delete $item->{"converted_from_${_}_id"};
361 $self->update_attributes(closed => 1);
373 sprintf "%s %s (%s)",
375 $self->customervendor->name,
376 $self->date->to_kivitendo;
388 SL::DB::DeliveryOrder - Rose model for delivery orders (table
397 An alias for C<transdate> for compatibility with other sales/purchase models.
399 =item C<displayable_name>
401 Returns a human-readable and translated description of the delivery order, consisting of
402 record type and number, e.g. "Verkaufslieferschein 123".
404 =item C<displayable_state>
406 Returns a human-readable description of the state regarding being
407 closed and delivered.
411 An alias for C<delivery_order_items> for compatibility with other
412 sales/purchase models.
414 =item C<new_from $source, %params>
416 Creates a new C<SL::DB::DeliveryOrder> instance and copies as much
417 information from C<$source> as possible. At the moment only instances
418 of C<SL::DB::Order> (sales quotations, sales orders, requests for
419 quotations and purchase orders) are supported as sources.
421 The conversion copies order items into delivery order items. Dates are copied
422 as appropriate, e.g. the C<transdate> field will be set to the current date.
424 Returns the new delivery order instance. The object returned is not
427 C<%params> can include the following options:
433 An optional array reference of RDBO instances for the items to use. If
434 missing then the method C<items_sorted> will be called on
435 C<$source>. This option can be used to override the sorting, to
436 exclude certain positions or to add additional ones.
438 =item C<skip_items_negative_qty>
440 If trueish then items with a negative quantity are skipped. Items with
441 a quantity of 0 are not affected by this option.
443 =item C<skip_items_zero_qty>
445 If trueish then items with a quantity of 0 are skipped.
449 An optional code reference that is called for each item with the item
450 as its sole parameter. Items for which the code reference returns a
451 falsish value will be skipped.
455 An optional hash reference. If it exists then it is passed to C<new>
456 allowing the caller to set certain attributes for the new delivery
461 =item C<new_from_time_recordings $sources, %params>
463 Creates a new C<SL::DB::DeliveryOrder> instance from the time recordings
464 given as C<$sources>. All time recording entries must belong to the same
465 customer. Time recordings are sorted by article and date. For each article
466 a new delivery order item is created. If no article is associated with an
467 entry, a default article will be used. The article given in the time
468 recording entry can be overriden.
469 Entries of the same date (for each article) are summed together and form a
470 list entry in the long description of the item.
472 The created delivery order object will be returnd but not saved.
474 C<$sources> must be an array reference of C<SL::DB::TimeRecording> instances.
476 C<%params> can include the following options:
482 An optional hash reference. If it exists then it is used to set
483 attributes of the newly created delivery order object.
485 =item C<default_part_id>
487 An optional part id which is used as default value if no part is set
488 in the time recording entry.
490 =item C<default_partnumber>
492 Like C<default_part_id> but given as partnumber, not as id.
494 =item C<override_part_id>
496 An optional part id which is used instead of a value set in the time
499 =item C<override_partnumber>
501 Like C<overrride_part_id> but given as partnumber, not as id.
503 =item C<related_order>
505 An optional C<SL::DB::Order> object. If it exists then it is used to
506 generate the delivery order from that via C<new_from>.
507 The generated items are created from a suitable item of the related
508 order. If no suitable item is found, an exception is thrown.
512 An optional boolean value. If truish, then the durations of the time entries
513 are rounded up to the full quarters of an hour.
519 TODO: Describe sales_order
523 Returns a string describing this record's type: either
524 C<sales_delivery_order> or C<purchase_delivery_order>.
526 =item C<convert_to_invoice %params>
528 Creates a new invoice with C<$self> as the basis by calling
529 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
530 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
531 C<closed> attribute is set to C<true>, and C<$self> is saved.
533 The arguments in C<%params> are passed to L<SL::DB::Invoice::new_from>.
535 Returns the new invoice instance on success and C<undef> on
536 failure. The whole process is run inside a transaction. On failure
537 nothing is created or changed in the database.
539 At the moment only sales delivery orders can be converted.
549 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>