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