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