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