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