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::Controller::DeliveryOrder::TypeData;
  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 displayable_type {
  86   my $type = shift->type;
  87
  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';
  90
  91   die 'invalid type';
  92 }
  93
  94 sub displayable_name {
  95   join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
  96 };
  97
  98 sub displayable_state {
  99   my ($self) = @_;
 100
 101   return join '; ',
 102     ($self->closed    ? $::locale->text('closed')    : $::locale->text('open')),
 103     ($self->delivered ? $::locale->text('delivered') : $::locale->text('not delivered'));
 104 }
 105
 106 sub date {
 107   goto &transdate;
 108 }
 109
 110 sub number {
 111   goto &donumber;
 112 }
 113
 114 sub _clone_orderitem_cvar {
 115   my ($cvar) = @_;
 116
 117   my $cloned = $_->clone_and_reset;
 118   $cloned->sub_module('delivery_order_items');
 119
 120   return $cloned;
 121 }
 122
 123 sub new_from {
 124   my ($class, $source, %params) = @_;
 125
 126   croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
 127
 128   my ($item_parent_id_column, $item_parent_column);
 129
 130   if (ref($source) eq 'SL::DB::Order') {
 131     $item_parent_id_column = 'trans_id';
 132     $item_parent_column    = 'order';
 133   }
 134
 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
 137                                              )),
 138                closed    => 0,
 139                is_sales  => !!$source->customer_id,
 140                delivered => 0,
 141                transdate => DateTime->today_local,
 142             );
 143
 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;
 150
 151   } else {
 152     $args{shipto_id} = $source->shipto_id;
 153   }
 154
 155   # infer type from legacy fields if not given
 156   $args{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";
 160
 161   # overwrite legacy is_sales from type_data
 162   $args{is_sales} = SL::Controller::DeliveryOrder::TypeData::get3($args{order_type}, "properties", "is_customer");
 163
 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;
 167   my %item_parents;
 168
 169   my @items = map {
 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 };
 173
 174     $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
 175     my $item_parent                  = $item_parents{$source_item_id};
 176
 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
 180                                          )),
 181                                    custom_variables => \@custom_variables,
 182                                    ordnumber        => ref($item_parent) eq 'SL::DB::Order' ? $item_parent->ordnumber : $source_item->ordnumber,
 183                                  );
 184     $current_do_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
 185     $current_do_item;
 186   } @{ $items };
 187
 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};
 191
 192   $delivery_order->items(\@items);
 193
 194   return $delivery_order;
 195 }
 196
 197 sub new_from_time_recordings {
 198   my ($class, $sources, %params) = @_;
 199
 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;
 202
 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
 210   #
 211
 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
 214                        : undef;
 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
 217                        : undef;
 218
 219   # check parts and collect entries
 220   my %part_by_part_id;
 221   my $entries;
 222   foreach my $source (@$sources) {
 223     next if !$source->duration;
 224
 225     my $part_id   = $override_part_id;
 226     $part_id    ||= $source->part_id;
 227     $part_id    ||= $default_part_id;
 228
 229     die 'article not found for entry "' . $source->displayable_times . '"' if !$part_id;
 230
 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;
 234     }
 235
 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/;
 245
 246     $entries->{$part_id}->{$date}->{date_obj}  = $source->start_time || $source->date; # for sorting
 247   }
 248
 249   my @items;
 250
 251   my $h_unit = SL::DB::Manager::Unit->find_h_unit;
 252
 253   my @keys = sort { $part_by_part_id{$a}->partnumber cmp $part_by_part_id{$b}->partnumber } keys %$entries;
 254   foreach my $key (@keys) {
 255     my $qty = 0;
 256     my $longdescription = '';
 257
 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};
 261
 262       $qty             += $entry->{duration};
 263       $longdescription .= $date . ' <strong>' . _format_total($entry->{duration}) . ' h</strong>';
 264       $longdescription .= '<ul>';
 265       $longdescription .= $entry->{content};
 266       $longdescription .= '</ul>';
 267     }
 268
 269     my $item = SL::DB::DeliveryOrderItem->new(
 270       parts_id        => $part_by_part_id{$key}->id,
 271       description     => $part_by_part_id{$key}->description,
 272       qty             => $qty,
 273       base_qty        => $h_unit->convert_to($qty, $part_by_part_id{$key}->unit_obj),
 274       unit_obj        => $h_unit,
 275       sellprice       => $part_by_part_id{$key}->sellprice, # Todo: use price rules to get sellprice
 276       longdescription => $longdescription,
 277     );
 278
 279     push @items, $item;
 280   }
 281
 282   my $delivery_order;
 283
 284   if ($params{related_order}) {
 285     # collect suitable items in related order
 286     my @items_to_use;
 287     my @new_attributes;
 288     foreach my $item (@items) {
 289       my $item_to_use = first {$item->parts_id == $_->parts_id} @{ $params{related_order}->items_sorted };
 290
 291       die "no suitable item found in related order" if !$item_to_use;
 292
 293       my %new_attributes;
 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;
 297     }
 298
 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;
 301
 302   } else {
 303     my %args = (
 304       is_sales    => 1,
 305       order_type  => 'sales_delivery_order',
 306       delivered   => 0,
 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,
 312       items       => \@items,
 313     );
 314     $delivery_order = $class->new(%args);
 315     $delivery_order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
 316   }
 317
 318   return $delivery_order;
 319 }
 320
 321 # legacy for compatibility
 322 # use type_data cusomtervendor and transfer direction instead
 323 sub is_sales {
 324   if ($_[0]->order_type) {
 325    return SL::Controller::DeliveryOrder::TypeData::get3($_[0]->order_type, "properties", "is_customer");
 326   }
 327   return $_[0]{is_sales};
 328 }
 329
 330 sub customervendor {
 331   SL::Controller::DeliveryOrder::TypeData::get3($_[0]->order_type, "properties", "is_customer") ? $_[0]->customer : $_[0]->vendor;
 332 }
 333
 334 sub convert_to_invoice {
 335   my ($self, %params) = @_;
 336
 337   croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
 338
 339   my $invoice;
 340   if (!$self->db->with_transaction(sub {
 341     require SL::DB::Invoice;
 342     $invoice = SL::DB::Invoice->new_from($self, %params)->post || die;
 343     $self->link_to_record($invoice);
 344     # TODO extend link_to_record for items, otherwise long-term no d.r.y.
 345     foreach my $item (@{ $invoice->items }) {
 346       foreach (qw(delivery_order_items)) {    # expand if needed (orderitems)
 347         if ($item->{"converted_from_${_}_id"}) {
 348           die unless $item->{id};
 349           RecordLinks->create_links('mode'       => 'ids',
 350                                     'from_table' => $_,
 351                                     'from_ids'   => $item->{"converted_from_${_}_id"},
 352                                     'to_table'   => 'invoice',
 353                                     'to_id'      => $item->{id},
 354           ) || die;
 355           delete $item->{"converted_from_${_}_id"};
 356         }
 357       }
 358     }
 359     $self->update_attributes(closed => 1);
 360     1;
 361   })) {
 362     return undef;
 363   }
 364
 365   return $invoice;
 366 }
 367
 368 sub digest {
 369   my ($self) = @_;
 370
 371   sprintf "%s %s (%s)",
 372     $self->donumber,
 373     $self->customervendor->name,
 374     $self->date->to_kivitendo;
 375 }
 376
 377 1;
 378 __END__
 379
 380 =pod
 381
 382 =encoding utf8
 383
 384 =head1 NAME
 385
 386 SL::DB::DeliveryOrder - Rose model for delivery orders (table
 387 "delivery_orders")
 388
 389 =head1 FUNCTIONS
 390
 391 =over 4
 392
 393 =item C<date>
 394
 395 An alias for C<transdate> for compatibility with other sales/purchase models.
 396
 397 =item C<displayable_name>
 398
 399 Returns a human-readable and translated description of the delivery order, consisting of
 400 record type and number, e.g. "Verkaufslieferschein 123".
 401
 402 =item C<displayable_state>
 403
 404 Returns a human-readable description of the state regarding being
 405 closed and delivered.
 406
 407 =item C<items>
 408
 409 An alias for C<delivery_order_items> for compatibility with other
 410 sales/purchase models.
 411
 412 =item C<new_from $source, %params>
 413
 414 Creates a new C<SL::DB::DeliveryOrder> instance and copies as much
 415 information from C<$source> as possible. At the moment only instances
 416 of C<SL::DB::Order> (sales quotations, sales orders, requests for
 417 quotations and purchase orders) are supported as sources.
 418
 419 The conversion copies order items into delivery order items. Dates are copied
 420 as appropriate, e.g. the C<transdate> field will be set to the current date.
 421
 422 Returns the new delivery order instance. The object returned is not
 423 saved.
 424
 425 C<%params> can include the following options:
 426
 427 =over 2
 428
 429 =item C<items>
 430
 431 An optional array reference of RDBO instances for the items to use. If
 432 missing then the method C<items_sorted> will be called on
 433 C<$source>. This option can be used to override the sorting, to
 434 exclude certain positions or to add additional ones.
 435
 436 =item C<skip_items_negative_qty>
 437
 438 If trueish then items with a negative quantity are skipped. Items with
 439 a quantity of 0 are not affected by this option.
 440
 441 =item C<skip_items_zero_qty>
 442
 443 If trueish then items with a quantity of 0 are skipped.
 444
 445 =item C<item_filter>
 446
 447 An optional code reference that is called for each item with the item
 448 as its sole parameter. Items for which the code reference returns a
 449 falsish value will be skipped.
 450
 451 =item C<attributes>
 452
 453 An optional hash reference. If it exists then it is passed to C<new>
 454 allowing the caller to set certain attributes for the new delivery
 455 order.
 456
 457 =back
 458
 459 =item C<new_from_time_recordings $sources, %params>
 460
 461 Creates a new C<SL::DB::DeliveryOrder> instance from the time recordings
 462 given as C<$sources>. All time recording entries must belong to the same
 463 customer. Time recordings are sorted by article and date. For each article
 464 a new delivery order item is created. If no article is associated with an
 465 entry, a default article will be used. The article given in the time
 466 recording entry can be overriden.
 467 Entries of the same date (for each article) are summed together and form a
 468 list entry in the long description of the item.
 469
 470 The created delivery order object will be returnd but not saved.
 471
 472 C<$sources> must be an array reference of C<SL::DB::TimeRecording> instances.
 473
 474 C<%params> can include the following options:
 475
 476 =over 2
 477
 478 =item C<attributes>
 479
 480 An optional hash reference. If it exists then it is used to set
 481 attributes of the newly created delivery order object.
 482
 483 =item C<default_part_id>
 484
 485 An optional part id which is used as default value if no part is set
 486 in the time recording entry.
 487
 488 =item C<default_partnumber>
 489
 490 Like C<default_part_id> but given as partnumber, not as id.
 491
 492 =item C<override_part_id>
 493
 494 An optional part id which is used instead of a value set in the time
 495 recording entry.
 496
 497 =item C<override_partnumber>
 498
 499 Like C<overrride_part_id> but given as partnumber, not as id.
 500
 501 =item C<related_order>
 502
 503 An optional C<SL::DB::Order> object. If it exists then it is used to
 504 generate the delivery order from that via C<new_from>.
 505 The generated items are created from a suitable item of the related
 506 order. If no suitable item is found, an exception is thrown.
 507
 508 =item C<rounding>
 509
 510 An optional boolean value. If truish, then the durations of the time entries
 511 are rounded up to the full quarters of an hour.
 512
 513 =back
 514
 515 =item C<sales_order>
 516
 517 TODO: Describe sales_order
 518
 519 =item C<type>
 520
 521 Returns a string describing this record's type: either
 522 C<sales_delivery_order> or C<purchase_delivery_order>.
 523
 524 =item C<convert_to_invoice %params>
 525
 526 Creates a new invoice with C<$self> as the basis by calling
 527 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
 528 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
 529 C<closed> attribute is set to C<true>, and C<$self> is saved.
 530
 531 The arguments in C<%params> are passed to L<SL::DB::Invoice::new_from>.
 532
 533 Returns the new invoice instance on success and C<undef> on
 534 failure. The whole process is run inside a transaction. On failure
 535 nothing is created or changed in the database.
 536
 537 At the moment only sales delivery orders can be converted.
 538
 539 =back
 540
 541 =head1 BUGS
 542
 543 Nothing here yet.
 544
 545 =head1 AUTHOR
 546
 547 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 548
 549 =cut