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
143 is_sales => !!$source->customer_id,
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 # overwrite legacy is_sales from type_data
166 $args{is_sales} = SL::Controller::DeliveryOrder::TypeData::get3($args{order_type}, "properties", "is_customer");
168 my $delivery_order = $class->new(%args);
169 $delivery_order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
170 my $items = delete($params{items}) || $source->items_sorted;
174 my $source_item = $_;
175 my $source_item_id = $_->$item_parent_id_column;
176 my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
178 $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
179 my $item_parent = $item_parents{$source_item_id};
181 my $current_do_item = SL::DB::DeliveryOrderItem->new(map({ ( $_ => $source_item->$_ ) }
182 qw(base_qty cusordnumber description discount lastcost longdescription marge_price_factor parts_id price_factor price_factor_id
183 project_id qty reqdate sellprice serialnumber transdate unit active_discount_source active_price_source
185 custom_variables => \@custom_variables,
186 ordnumber => ref($item_parent) eq 'SL::DB::Order' ? $item_parent->ordnumber : $source_item->ordnumber,
188 $current_do_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
192 @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
193 @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
194 @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
196 $delivery_order->items(\@items);
198 return $delivery_order;
201 sub new_from_time_recordings {
202 my ($class, $sources, %params) = @_;
204 croak("Unsupported object type in sources") if any { ref($_) ne 'SL::DB::TimeRecording' } @$sources;
205 croak("Cannot create delivery order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
207 # - one item per part (article)
208 # - qty is sum of duration
209 # - description goes to item longdescription
210 # - ordered and summed by date
211 # - each description goes to an ordered list
212 # - (as time recording descriptions are formatted text by now, use stripped text)
213 # - merge same descriptions
216 my $default_part_id = $params{default_part_id} ? $params{default_part_id}
217 : $params{default_partnumber} ? SL::DB::Manager::Part->find_by(partnumber => $params{default_partnumber})->id
219 my $override_part_id = $params{override_part_id} ? $params{override_part_id}
220 : $params{override_partnumber} ? SL::DB::Manager::Part->find_by(partnumber => $params{override_partnumber})->id
223 # check parts and collect entries
226 foreach my $source (@$sources) {
227 next if !$source->duration;
229 my $part_id = $override_part_id;
230 $part_id ||= $source->part_id;
231 $part_id ||= $default_part_id;
233 die 'article not found for entry "' . $source->displayable_times . '"' if !$part_id;
235 if (!$part_by_part_id{$part_id}) {
236 $part_by_part_id{$part_id} = SL::DB::Part->new(id => $part_id)->load;
237 die 'article unit must be time based for entry "' . $source->displayable_times . '"' if !$part_by_part_id{$part_id}->unit_obj->is_time_based;
240 my $date = $source->date->to_kivitendo;
241 $entries->{$part_id}->{$date}->{duration} += $params{rounding}
242 ? nhimult(0.25, ($source->duration_in_hours))
243 : _round_total($source->duration_in_hours);
244 # add content if not already in description
245 my $new_description = '' . $source->description_as_stripped_html;
246 $entries->{$part_id}->{$date}->{content} ||= '';
247 $entries->{$part_id}->{$date}->{content} .= '<li>' . $new_description . '</li>'
248 unless $entries->{$part_id}->{$date}->{content} =~ m/\Q$new_description/;
250 $entries->{$part_id}->{$date}->{date_obj} = $source->start_time || $source->date; # for sorting
255 my $h_unit = SL::DB::Manager::Unit->find_h_unit;
257 my @keys = sort { $part_by_part_id{$a}->partnumber cmp $part_by_part_id{$b}->partnumber } keys %$entries;
258 foreach my $key (@keys) {
260 my $longdescription = '';
262 my @dates = sort { $entries->{$key}->{$a}->{date_obj} <=> $entries->{$key}->{$b}->{date_obj} } keys %{$entries->{$key}};
263 foreach my $date (@dates) {
264 my $entry = $entries->{$key}->{$date};
266 $qty += $entry->{duration};
267 $longdescription .= $date . ' <strong>' . _format_total($entry->{duration}) . ' h</strong>';
268 $longdescription .= '<ul>';
269 $longdescription .= $entry->{content};
270 $longdescription .= '</ul>';
273 my $item = SL::DB::DeliveryOrderItem->new(
274 parts_id => $part_by_part_id{$key}->id,
275 description => $part_by_part_id{$key}->description,
277 base_qty => $h_unit->convert_to($qty, $part_by_part_id{$key}->unit_obj),
279 sellprice => $part_by_part_id{$key}->sellprice, # Todo: use price rules to get sellprice
280 longdescription => $longdescription,
288 if ($params{related_order}) {
289 # collect suitable items in related order
292 foreach my $item (@items) {
293 my $item_to_use = first {$item->parts_id == $_->parts_id} @{ $params{related_order}->items_sorted };
295 die "no suitable item found in related order" if !$item_to_use;
298 $new_attributes{$_} = $item->$_ for qw(qty base_qty unit_obj longdescription);
299 push @items_to_use, $item_to_use;
300 push @new_attributes, \%new_attributes;
303 $delivery_order = $class->new_from($params{related_order}, items => \@items_to_use, %params);
304 pairwise { $a->assign_attributes( %$b) } @{$delivery_order->items}, @new_attributes;
309 order_type => 'sales_delivery_order',
311 customer_id => $sources->[0]->customer_id,
312 taxzone_id => $sources->[0]->customer->taxzone_id,
313 currency_id => $sources->[0]->customer->currency_id,
314 employee_id => SL::DB::Manager::Employee->current->id,
315 salesman_id => SL::DB::Manager::Employee->current->id,
318 $delivery_order = $class->new(%args);
319 $delivery_order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
322 return $delivery_order;
325 # legacy for compatibility
326 # use type_data cusomtervendor and transfer direction instead
328 if ($_[0]->order_type) {
329 return SL::DB::DeliveryOrder::TypeData::get3($_[0]->order_type, "properties", "is_customer");
331 return $_[0]{is_sales};
335 SL::DB::DeliveryOrder::TypeData::get3($_[0]->order_type, "properties", "is_customer") ? $_[0]->customer : $_[0]->vendor;
338 sub convert_to_invoice {
339 my ($self, %params) = @_;
341 croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
344 if (!$self->db->with_transaction(sub {
345 require SL::DB::Invoice;
346 $invoice = SL::DB::Invoice->new_from($self, %params)->post || die;
347 $self->link_to_record($invoice);
348 # TODO extend link_to_record for items, otherwise long-term no d.r.y.
349 foreach my $item (@{ $invoice->items }) {
350 foreach (qw(delivery_order_items)) { # expand if needed (orderitems)
351 if ($item->{"converted_from_${_}_id"}) {
352 die unless $item->{id};
353 RecordLinks->create_links('mode' => 'ids',
355 'from_ids' => $item->{"converted_from_${_}_id"},
356 'to_table' => 'invoice',
357 'to_id' => $item->{id},
359 delete $item->{"converted_from_${_}_id"};
363 $self->update_attributes(closed => 1);
375 sprintf "%s %s (%s)",
377 $self->customervendor->name,
378 $self->date->to_kivitendo;
390 SL::DB::DeliveryOrder - Rose model for delivery orders (table
399 An alias for C<transdate> for compatibility with other sales/purchase models.
401 =item C<displayable_name>
403 Returns a human-readable and translated description of the delivery order, consisting of
404 record type and number, e.g. "Verkaufslieferschein 123".
406 =item C<displayable_state>
408 Returns a human-readable description of the state regarding being
409 closed and delivered.
413 An alias for C<delivery_order_items> for compatibility with other
414 sales/purchase models.
416 =item C<new_from $source, %params>
418 Creates a new C<SL::DB::DeliveryOrder> instance and copies as much
419 information from C<$source> as possible. At the moment only instances
420 of C<SL::DB::Order> (sales quotations, sales orders, requests for
421 quotations and purchase orders) are supported as sources.
423 The conversion copies order items into delivery order items. Dates are copied
424 as appropriate, e.g. the C<transdate> field will be set to the current date.
426 Returns the new delivery order instance. The object returned is not
429 C<%params> can include the following options:
435 An optional array reference of RDBO instances for the items to use. If
436 missing then the method C<items_sorted> will be called on
437 C<$source>. This option can be used to override the sorting, to
438 exclude certain positions or to add additional ones.
440 =item C<skip_items_negative_qty>
442 If trueish then items with a negative quantity are skipped. Items with
443 a quantity of 0 are not affected by this option.
445 =item C<skip_items_zero_qty>
447 If trueish then items with a quantity of 0 are skipped.
451 An optional code reference that is called for each item with the item
452 as its sole parameter. Items for which the code reference returns a
453 falsish value will be skipped.
457 An optional hash reference. If it exists then it is passed to C<new>
458 allowing the caller to set certain attributes for the new delivery
463 =item C<new_from_time_recordings $sources, %params>
465 Creates a new C<SL::DB::DeliveryOrder> instance from the time recordings
466 given as C<$sources>. All time recording entries must belong to the same
467 customer. Time recordings are sorted by article and date. For each article
468 a new delivery order item is created. If no article is associated with an
469 entry, a default article will be used. The article given in the time
470 recording entry can be overriden.
471 Entries of the same date (for each article) are summed together and form a
472 list entry in the long description of the item.
474 The created delivery order object will be returnd but not saved.
476 C<$sources> must be an array reference of C<SL::DB::TimeRecording> instances.
478 C<%params> can include the following options:
484 An optional hash reference. If it exists then it is used to set
485 attributes of the newly created delivery order object.
487 =item C<default_part_id>
489 An optional part id which is used as default value if no part is set
490 in the time recording entry.
492 =item C<default_partnumber>
494 Like C<default_part_id> but given as partnumber, not as id.
496 =item C<override_part_id>
498 An optional part id which is used instead of a value set in the time
501 =item C<override_partnumber>
503 Like C<overrride_part_id> but given as partnumber, not as id.
505 =item C<related_order>
507 An optional C<SL::DB::Order> object. If it exists then it is used to
508 generate the delivery order from that via C<new_from>.
509 The generated items are created from a suitable item of the related
510 order. If no suitable item is found, an exception is thrown.
514 An optional boolean value. If truish, then the durations of the time entries
515 are rounded up to the full quarters of an hour.
521 TODO: Describe sales_order
525 Returns a string describing this record's type: either
526 C<sales_delivery_order> or C<purchase_delivery_order>.
528 =item C<convert_to_invoice %params>
530 Creates a new invoice with C<$self> as the basis by calling
531 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
532 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
533 C<closed> attribute is set to C<true>, and C<$self> is saved.
535 The arguments in C<%params> are passed to L<SL::DB::Invoice::new_from>.
537 Returns the new invoice instance on success and C<undef> on
538 failure. The whole process is run inside a transaction. On failure
539 nothing is created or changed in the database.
541 At the moment only sales delivery orders can be converted.
551 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>