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