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::Controller::DeliveryOrder::TypeData;
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 };
85 sub displayable_type {
86 my $type = shift->type;
88 return $::locale->text('Sales Delivery Order') if $type eq 'sales_delivery_order';
89 return $::locale->text('Purchase Delivery Order') if $type eq 'purchase_delivery_order';
94 sub displayable_name {
95 join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
98 sub displayable_state {
102 ($self->closed ? $::locale->text('closed') : $::locale->text('open')),
103 ($self->delivered ? $::locale->text('delivered') : $::locale->text('not delivered'));
114 sub _clone_orderitem_cvar {
117 my $cloned = $_->clone_and_reset;
118 $cloned->sub_module('delivery_order_items');
124 my ($class, $source, %params) = @_;
126 croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
128 my ($item_parent_id_column, $item_parent_column);
130 if (ref($source) eq 'SL::DB::Order') {
131 $item_parent_id_column = 'trans_id';
132 $item_parent_column = 'order';
135 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
136 ordnumber payment_id reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id transaction_description vendor_id billing_address_id
139 is_sales => !!$source->customer_id,
141 transdate => DateTime->today_local,
144 # Custom shipto addresses (the ones specific to the sales/purchase
145 # record and not to the customer/vendor) are only linked from
146 # shipto → delivery_orders. Meaning delivery_orders.shipto_id
147 # will not be filled in that case.
148 if (!$source->shipto_id && $source->id) {
149 $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
152 $args{shipto_id} = $source->shipto_id;
155 # infer type from legacy fields if not given
156 $params{order_type} //= $source->customer_id ? 'sales_delivery_order'
157 : $source->vendor_id ? 'purchase_delivery_order'
158 : $source->is_sales ? 'sales_delivery_order'
159 : croak "need some way to set delivery order type from source";
161 # overwrite legacy is_sales from type_data
162 $args{is_sales} = SL::Controller::DeliveryOrder::TypeData::get3($params{order_type}, "properties", "is_customer");
164 my $delivery_order = $class->new(%args);
165 $delivery_order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
166 my $items = delete($params{items}) || $source->items_sorted;
170 my $source_item = $_;
171 my $source_item_id = $_->$item_parent_id_column;
172 my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
174 $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
175 my $item_parent = $item_parents{$source_item_id};
177 my $current_do_item = SL::DB::DeliveryOrderItem->new(map({ ( $_ => $source_item->$_ ) }
178 qw(base_qty cusordnumber description discount lastcost longdescription marge_price_factor parts_id price_factor price_factor_id
179 project_id qty reqdate sellprice serialnumber transdate unit active_discount_source active_price_source
181 custom_variables => \@custom_variables,
182 ordnumber => ref($item_parent) eq 'SL::DB::Order' ? $item_parent->ordnumber : $source_item->ordnumber,
184 $current_do_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
188 @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
189 @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
190 @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
192 $delivery_order->items(\@items);
194 return $delivery_order;
197 sub new_from_time_recordings {
198 my ($class, $sources, %params) = @_;
200 croak("Unsupported object type in sources") if any { ref($_) ne 'SL::DB::TimeRecording' } @$sources;
201 croak("Cannot create delivery order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
203 # - one item per part (article)
204 # - qty is sum of duration
205 # - description goes to item longdescription
206 # - ordered and summed by date
207 # - each description goes to an ordered list
208 # - (as time recording descriptions are formatted text by now, use stripped text)
209 # - merge same descriptions
212 my $default_part_id = $params{default_part_id} ? $params{default_part_id}
213 : $params{default_partnumber} ? SL::DB::Manager::Part->find_by(partnumber => $params{default_partnumber})->id
215 my $override_part_id = $params{override_part_id} ? $params{override_part_id}
216 : $params{override_partnumber} ? SL::DB::Manager::Part->find_by(partnumber => $params{override_partnumber})->id
219 # check parts and collect entries
222 foreach my $source (@$sources) {
223 next if !$source->duration;
225 my $part_id = $override_part_id;
226 $part_id ||= $source->part_id;
227 $part_id ||= $default_part_id;
229 die 'article not found for entry "' . $source->displayable_times . '"' if !$part_id;
231 if (!$part_by_part_id{$part_id}) {
232 $part_by_part_id{$part_id} = SL::DB::Part->new(id => $part_id)->load;
233 die 'article unit must be time based for entry "' . $source->displayable_times . '"' if !$part_by_part_id{$part_id}->unit_obj->is_time_based;
236 my $date = $source->date->to_kivitendo;
237 $entries->{$part_id}->{$date}->{duration} += $params{rounding}
238 ? nhimult(0.25, ($source->duration_in_hours))
239 : _round_total($source->duration_in_hours);
240 # add content if not already in description
241 my $new_description = '' . $source->description_as_stripped_html;
242 $entries->{$part_id}->{$date}->{content} ||= '';
243 $entries->{$part_id}->{$date}->{content} .= '<li>' . $new_description . '</li>'
244 unless $entries->{$part_id}->{$date}->{content} =~ m/\Q$new_description/;
246 $entries->{$part_id}->{$date}->{date_obj} = $source->start_time || $source->date; # for sorting
251 my $h_unit = SL::DB::Manager::Unit->find_h_unit;
253 my @keys = sort { $part_by_part_id{$a}->partnumber cmp $part_by_part_id{$b}->partnumber } keys %$entries;
254 foreach my $key (@keys) {
256 my $longdescription = '';
258 my @dates = sort { $entries->{$key}->{$a}->{date_obj} <=> $entries->{$key}->{$b}->{date_obj} } keys %{$entries->{$key}};
259 foreach my $date (@dates) {
260 my $entry = $entries->{$key}->{$date};
262 $qty += $entry->{duration};
263 $longdescription .= $date . ' <strong>' . _format_total($entry->{duration}) . ' h</strong>';
264 $longdescription .= '<ul>';
265 $longdescription .= $entry->{content};
266 $longdescription .= '</ul>';
269 my $item = SL::DB::DeliveryOrderItem->new(
270 parts_id => $part_by_part_id{$key}->id,
271 description => $part_by_part_id{$key}->description,
273 base_qty => $h_unit->convert_to($qty, $part_by_part_id{$key}->unit_obj),
275 sellprice => $part_by_part_id{$key}->sellprice, # Todo: use price rules to get sellprice
276 longdescription => $longdescription,
284 if ($params{related_order}) {
285 # collect suitable items in related order
288 foreach my $item (@items) {
289 my $item_to_use = first {$item->parts_id == $_->parts_id} @{ $params{related_order}->items_sorted };
291 die "no suitable item found in related order" if !$item_to_use;
294 $new_attributes{$_} = $item->$_ for qw(qty base_qty unit_obj longdescription);
295 push @items_to_use, $item_to_use;
296 push @new_attributes, \%new_attributes;
299 $delivery_order = $class->new_from($params{related_order}, items => \@items_to_use, %params);
300 pairwise { $a->assign_attributes( %$b) } @{$delivery_order->items}, @new_attributes;
305 order_type => 'sales_delivery_order',
307 customer_id => $sources->[0]->customer_id,
308 taxzone_id => $sources->[0]->customer->taxzone_id,
309 currency_id => $sources->[0]->customer->currency_id,
310 employee_id => SL::DB::Manager::Employee->current->id,
311 salesman_id => SL::DB::Manager::Employee->current->id,
314 $delivery_order = $class->new(%args);
315 $delivery_order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
318 return $delivery_order;
321 # legacy for compatibility
322 # use type_data cusomtervendor and transfer direction instead
324 SL::Controller::DeliveryOrder::TypeData::get3($_[0]->order_type, "properties", "is_customer");
328 SL::Controller::DeliveryOrder::TypeData::get3($_[0]->order_type, "properties", "is_customer") ? $_[0]->customer : $_[0]->vendor;
331 sub convert_to_invoice {
332 my ($self, %params) = @_;
334 croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
337 if (!$self->db->with_transaction(sub {
338 require SL::DB::Invoice;
339 $invoice = SL::DB::Invoice->new_from($self, %params)->post || die;
340 $self->link_to_record($invoice);
341 # TODO extend link_to_record for items, otherwise long-term no d.r.y.
342 foreach my $item (@{ $invoice->items }) {
343 foreach (qw(delivery_order_items)) { # expand if needed (orderitems)
344 if ($item->{"converted_from_${_}_id"}) {
345 die unless $item->{id};
346 RecordLinks->create_links('mode' => 'ids',
348 'from_ids' => $item->{"converted_from_${_}_id"},
349 'to_table' => 'invoice',
350 'to_id' => $item->{id},
352 delete $item->{"converted_from_${_}_id"};
356 $self->update_attributes(closed => 1);
368 sprintf "%s %s (%s)",
370 $self->customervendor->name,
371 $self->date->to_kivitendo;
383 SL::DB::DeliveryOrder - Rose model for delivery orders (table
392 An alias for C<transdate> for compatibility with other sales/purchase models.
394 =item C<displayable_name>
396 Returns a human-readable and translated description of the delivery order, consisting of
397 record type and number, e.g. "Verkaufslieferschein 123".
399 =item C<displayable_state>
401 Returns a human-readable description of the state regarding being
402 closed and delivered.
406 An alias for C<delivery_order_items> for compatibility with other
407 sales/purchase models.
409 =item C<new_from $source, %params>
411 Creates a new C<SL::DB::DeliveryOrder> instance and copies as much
412 information from C<$source> as possible. At the moment only instances
413 of C<SL::DB::Order> (sales quotations, sales orders, requests for
414 quotations and purchase orders) are supported as sources.
416 The conversion copies order items into delivery order items. Dates are copied
417 as appropriate, e.g. the C<transdate> field will be set to the current date.
419 Returns the new delivery order instance. The object returned is not
422 C<%params> can include the following options:
428 An optional array reference of RDBO instances for the items to use. If
429 missing then the method C<items_sorted> will be called on
430 C<$source>. This option can be used to override the sorting, to
431 exclude certain positions or to add additional ones.
433 =item C<skip_items_negative_qty>
435 If trueish then items with a negative quantity are skipped. Items with
436 a quantity of 0 are not affected by this option.
438 =item C<skip_items_zero_qty>
440 If trueish then items with a quantity of 0 are skipped.
444 An optional code reference that is called for each item with the item
445 as its sole parameter. Items for which the code reference returns a
446 falsish value will be skipped.
450 An optional hash reference. If it exists then it is passed to C<new>
451 allowing the caller to set certain attributes for the new delivery
456 =item C<new_from_time_recordings $sources, %params>
458 Creates a new C<SL::DB::DeliveryOrder> instance from the time recordings
459 given as C<$sources>. All time recording entries must belong to the same
460 customer. Time recordings are sorted by article and date. For each article
461 a new delivery order item is created. If no article is associated with an
462 entry, a default article will be used. The article given in the time
463 recording entry can be overriden.
464 Entries of the same date (for each article) are summed together and form a
465 list entry in the long description of the item.
467 The created delivery order object will be returnd but not saved.
469 C<$sources> must be an array reference of C<SL::DB::TimeRecording> instances.
471 C<%params> can include the following options:
477 An optional hash reference. If it exists then it is used to set
478 attributes of the newly created delivery order object.
480 =item C<default_part_id>
482 An optional part id which is used as default value if no part is set
483 in the time recording entry.
485 =item C<default_partnumber>
487 Like C<default_part_id> but given as partnumber, not as id.
489 =item C<override_part_id>
491 An optional part id which is used instead of a value set in the time
494 =item C<override_partnumber>
496 Like C<overrride_part_id> but given as partnumber, not as id.
498 =item C<related_order>
500 An optional C<SL::DB::Order> object. If it exists then it is used to
501 generate the delivery order from that via C<new_from>.
502 The generated items are created from a suitable item of the related
503 order. If no suitable item is found, an exception is thrown.
507 An optional boolean value. If truish, then the durations of the time entries
508 are rounded up to the full quarters of an hour.
514 TODO: Describe sales_order
518 Returns a string describing this record's type: either
519 C<sales_delivery_order> or C<purchase_delivery_order>.
521 =item C<convert_to_invoice %params>
523 Creates a new invoice with C<$self> as the basis by calling
524 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
525 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
526 C<closed> attribute is set to C<true>, and C<$self> is saved.
528 The arguments in C<%params> are passed to L<SL::DB::Invoice::new_from>.
530 Returns the new invoice instance on success and C<undef> on
531 failure. The whole process is run inside a transaction. On failure
532 nothing is created or changed in the database.
534 At the moment only sales delivery orders can be converted.
544 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>