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   $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";
 160
 161   # overwrite legacy is_sales from type_data
 162   $args{is_sales} = SL::Controller::DeliveryOrder::TypeData::get3($params{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   SL::Controller::DeliveryOrder::TypeData::get3($_[0]->order_type, "properties", "is_customer");
 325 }
 326
 327 sub customervendor {
 328   SL::Controller::DeliveryOrder::TypeData::get3($_[0]->order_type, "properties", "is_customer") ? $_[0]->customer : $_[0]->vendor;
 329 }
 330
 331 sub convert_to_invoice {
 332   my ($self, %params) = @_;
 333
 334   croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
 335
 336   my $invoice;
 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',
 347                                     'from_table' => $_,
 348                                     'from_ids'   => $item->{"converted_from_${_}_id"},
 349                                     'to_table'   => 'invoice',
 350                                     'to_id'      => $item->{id},
 351           ) || die;
 352           delete $item->{"converted_from_${_}_id"};
 353         }
 354       }
 355     }
 356     $self->update_attributes(closed => 1);
 357     1;
 358   })) {
 359     return undef;
 360   }
 361
 362   return $invoice;
 363 }
 364
 365 sub digest {
 366   my ($self) = @_;
 367
 368   sprintf "%s %s (%s)",
 369     $self->donumber,
 370     $self->customervendor->name,
 371     $self->date->to_kivitendo;
 372 }
 373
 374 1;
 375 __END__
 376
 377 =pod
 378
 379 =encoding utf8
 380
 381 =head1 NAME
 382
 383 SL::DB::DeliveryOrder - Rose model for delivery orders (table
 384 "delivery_orders")
 385
 386 =head1 FUNCTIONS
 387
 388 =over 4
 389
 390 =item C<date>
 391
 392 An alias for C<transdate> for compatibility with other sales/purchase models.
 393
 394 =item C<displayable_name>
 395
 396 Returns a human-readable and translated description of the delivery order, consisting of
 397 record type and number, e.g. "Verkaufslieferschein 123".
 398
 399 =item C<displayable_state>
 400
 401 Returns a human-readable description of the state regarding being
 402 closed and delivered.
 403
 404 =item C<items>
 405
 406 An alias for C<delivery_order_items> for compatibility with other
 407 sales/purchase models.
 408
 409 =item C<new_from $source, %params>
 410
 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.
 415
 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.
 418
 419 Returns the new delivery order instance. The object returned is not
 420 saved.
 421
 422 C<%params> can include the following options:
 423
 424 =over 2
 425
 426 =item C<items>
 427
 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.
 432
 433 =item C<skip_items_negative_qty>
 434
 435 If trueish then items with a negative quantity are skipped. Items with
 436 a quantity of 0 are not affected by this option.
 437
 438 =item C<skip_items_zero_qty>
 439
 440 If trueish then items with a quantity of 0 are skipped.
 441
 442 =item C<item_filter>
 443
 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.
 447
 448 =item C<attributes>
 449
 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
 452 order.
 453
 454 =back
 455
 456 =item C<new_from_time_recordings $sources, %params>
 457
 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.
 466
 467 The created delivery order object will be returnd but not saved.
 468
 469 C<$sources> must be an array reference of C<SL::DB::TimeRecording> instances.
 470
 471 C<%params> can include the following options:
 472
 473 =over 2
 474
 475 =item C<attributes>
 476
 477 An optional hash reference. If it exists then it is used to set
 478 attributes of the newly created delivery order object.
 479
 480 =item C<default_part_id>
 481
 482 An optional part id which is used as default value if no part is set
 483 in the time recording entry.
 484
 485 =item C<default_partnumber>
 486
 487 Like C<default_part_id> but given as partnumber, not as id.
 488
 489 =item C<override_part_id>
 490
 491 An optional part id which is used instead of a value set in the time
 492 recording entry.
 493
 494 =item C<override_partnumber>
 495
 496 Like C<overrride_part_id> but given as partnumber, not as id.
 497
 498 =item C<related_order>
 499
 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.
 504
 505 =item C<rounding>
 506
 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.
 509
 510 =back
 511
 512 =item C<sales_order>
 513
 514 TODO: Describe sales_order
 515
 516 =item C<type>
 517
 518 Returns a string describing this record's type: either
 519 C<sales_delivery_order> or C<purchase_delivery_order>.
 520
 521 =item C<convert_to_invoice %params>
 522
 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.
 527
 528 The arguments in C<%params> are passed to L<SL::DB::Invoice::new_from>.
 529
 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.
 533
 534 At the moment only sales delivery orders can be converted.
 535
 536 =back
 537
 538 =head1 BUGS
 539
 540 Nothing here yet.
 541
 542 =head1 AUTHOR
 543
 544 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 545
 546 =cut