SL/DB/DeliveryOrder.pm

   1 package SL::DB::DeliveryOrder;
   2
   3 use strict;
   4
   5 use Carp;
   6
   7 use Rose::DB::Object::Helpers qw(as_tree strip);
   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::TypeDataProxy;
  16 use SL::DB::Helper::TransNumberGenerator;
  17 use SL::DB::Helper::RecordLink qw(RECORD_ID RECORD_TYPE_REF);
  18
  19 use SL::DB::DeliveryOrder::TypeData qw(:types);
  20 use SL::DB::Order::TypeData qw(:types);
  21 use SL::DB::Reclamation::TypeData qw(:types);
  22
  23 use SL::Helper::Number qw(_format_total _round_total);
  24 use SL::Helper::ShippedQty;
  25
  26 use List::Util qw(first);
  27 use List::MoreUtils qw(any pairwise);
  28 use Math::Round qw(nhimult);
  29
  30 __PACKAGE__->meta->add_relationship(orderitems => { type         => 'one to many',
  31                                                     class        => 'SL::DB::DeliveryOrderItem',
  32                                                     column_map   => { id => 'delivery_order_id' },
  33                                                     manager_args => { with_objects => [ 'part' ] }
  34                                                   },
  35                                     custom_shipto => {
  36                                       type        => 'one to one',
  37                                       class       => 'SL::DB::Shipto',
  38                                       column_map  => { id => 'trans_id' },
  39                                       query_args  => [ module => 'DO' ],
  40                                     },
  41                                    );
  42
  43 __PACKAGE__->meta->initialize;
  44
  45 __PACKAGE__->attr_html('notes');
  46 __PACKAGE__->attr_sorted('items');
  47
  48 __PACKAGE__->before_save('_before_save_set_donumber');
  49 __PACKAGE__->after_save('_after_save_link_records');
  50 __PACKAGE__->after_save('_mark_orders_if_delivered');
  51
  52 # hooks
  53
  54 sub _before_save_set_donumber {
  55   my ($self) = @_;
  56
  57   $self->create_trans_number if !$self->donumber;
  58
  59   return 1;
  60 }
  61
  62 sub _after_save_link_records {
  63   my ($self) = @_;
  64
  65   my @allowed_record_sources = qw(SL::DB::Reclamation SL::DB::Order);
  66   my @allowed_item_sources = qw(SL::DB::ReclamationItem SL::DB::OrderItem);
  67
  68   SL::DB::Helper::RecordLink::link_records(
  69     $self,
  70     \@allowed_record_sources,
  71     \@allowed_item_sources,
  72   );
  73 }
  74
  75 sub _mark_orders_if_delivered {
  76   my ($self) = @_;
  77   my $orders = $self->linked_records(from => 'Order');
  78   SL::Helper::ShippedQty->new->calculate($orders)->write_to_objects;
  79   foreach my $order (@$orders) {
  80     next if $order->is_sales != $self->is_sales;
  81     $order->update_attributes(delivered => $order->{delivered});
  82   }
  83   return 1;
  84 }
  85
  86 # methods
  87
  88 sub items { goto &orderitems; }
  89 sub add_items { goto &add_orderitems; }
  90 sub payment_terms { goto &payment; }
  91 sub record_number { goto &donumber; }
  92
  93 sub sales_order {
  94   my $self   = shift;
  95   my %params = @_;
  96
  97
  98   require SL::DB::Order;
  99   my $orders = SL::DB::Manager::Order->get_all(
 100     query => [
 101       ordnumber => $self->ordnumber,
 102       @{ $params{query} || [] },
 103     ],
 104   );
 105
 106   return first { $_->is_type(SALES_ORDER_TYPE()) } @{ $orders };
 107 }
 108
 109 sub type {
 110   goto &record_type;
 111 }
 112
 113 sub is_type {
 114   return shift->type eq shift;
 115 }
 116
 117 sub displayable_type {
 118   my ($self) = @_;
 119   return $self->type_data->text('type');
 120 }
 121
 122 sub displayable_name {
 123   join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
 124 };
 125
 126 sub displayable_state {
 127   my ($self) = @_;
 128
 129   return join '; ',
 130     ($self->closed    ? $::locale->text('closed')    : $::locale->text('open')),
 131     ($self->delivered ? $::locale->text('delivered') : $::locale->text('not delivered'));
 132 }
 133
 134 sub date {
 135   goto &transdate;
 136 }
 137
 138 sub number {
 139   goto &donumber;
 140 }
 141
 142 sub preceding_purchase_order_confirmations {
 143   my ($self) = @_;
 144
 145   my @lrs = ();
 146   if ($self->id) {
 147     @lrs = grep { $_->record_type eq PURCHASE_ORDER_CONFIRMATION_TYPE() } @{$self->linked_records(from => 'SL::DB::Order')};
 148   } else {
 149     if ('SL::DB::Order' eq $self->{RECORD_TYPE_REF()}) {
 150       my $order = SL::DB::Order->load_cached($self->{RECORD_ID()});
 151       push @lrs, $order if $order->record_type eq PURCHASE_ORDER_CONFIRMATION_TYPE();
 152     }
 153   }
 154
 155   return \@lrs;
 156 }
 157
 158 sub _clone_orderitem_cvar {
 159   my ($cvar) = @_;
 160
 161   my $cloned = $_->clone_and_reset;
 162   $cloned->sub_module('delivery_order_items');
 163
 164   return $cloned;
 165 }
 166
 167 sub convert_to_reclamation {
 168   my ($self, %params) = @_;
 169
 170   $params{destination_type} = $self->is_sales ? SALES_RECLAMATION_TYPE()
 171                                               : PURCHASE_RECLAMATION_TYPE();
 172
 173   my $reclamation = SL::DB::Reclamation->new_from($self, %params);
 174
 175   return $reclamation;
 176 }
 177
 178 sub new_from {
 179   my ($class, $source, %params) = @_;
 180
 181   my %allowed_sources = map { $_ => 1 } qw(
 182     SL::DB::Reclamation
 183     SL::DB::Order
 184     SL::DB::DeliveryOrder
 185   );
 186   unless( $allowed_sources{ref $source} ) {
 187     croak("Unsupported source object type '" . ref($source) . "'");
 188   }
 189
 190   my %record_args = (
 191     donumber => undef,
 192     employee => SL::DB::Manager::Employee->current,
 193     closed    => 0,
 194     delivered => 0,
 195     record_type => $params{destination_type},
 196     transdate => DateTime->today_local,
 197   );
 198
 199   if ( ref($source) eq 'SL::DB::Order' ) {
 200     map{ ( $record_args{$_} = $source->$_ ) } # {{{ for vim folds
 201     qw(
 202       billing_address_id
 203       cp_id
 204       currency_id
 205       cusordnumber
 206       customer_id
 207       delivery_term_id
 208       department_id
 209       globalproject_id
 210       intnotes
 211       language_id
 212       notes
 213       payment_id
 214       reqdate
 215       salesman_id
 216       shippingpoint
 217       shipvia
 218       taxincluded
 219       taxzone_id
 220       transaction_description
 221       vendor_confirmation_number
 222       vendor_id
 223     );
 224     if ($source->record_type eq PURCHASE_ORDER_CONFIRMATION_TYPE()) {
 225       $record_args{ordnumber} = join ' ', map { $_->ordnumber } @{$source->preceding_purchase_orders()};
 226     } else {
 227       $record_args{ordnumber} = $source->ordnumber;
 228     }
 229     # }}} for vim folds
 230   } elsif ( ref($source) eq 'SL::DB::Reclamation' ) {
 231     map{ ( $record_args{$_} = $source->$_ ) } # {{{ for vim folds
 232     qw(
 233       billing_address_id
 234       currency_id
 235       customer_id
 236       delivery_term_id
 237       department_id
 238       globalproject_id
 239       intnotes
 240       language_id
 241       notes
 242       payment_id
 243       reqdate
 244       salesman_id
 245       shippingpoint
 246       shipvia
 247       taxincluded
 248       taxzone_id
 249       transaction_description
 250       vendor_id
 251     );
 252     $record_args{cp_id} = $source->contact_id;
 253     $record_args{cusordnumber} = $source->cv_record_number;
 254     $record_args{is_sales} = $source->is_sales;
 255     # }}} for vim folds
 256   } elsif ( ref($source) eq 'SL::DB::DeliveryOrder' ) {
 257     map{ ( $record_args{$_} = $source->$_ ) } # {{{ for vim folds
 258     qw(
 259       billing_address_id
 260       cp_id
 261       currency_id
 262       cusordnumber
 263       customer_id
 264       delivery_term_id
 265       department_id
 266       donumber
 267       globalproject_id
 268       intnotes
 269       language_id
 270       notes
 271       ordnumber
 272       oreqnumber
 273       payment_id
 274       reqdate
 275       salesman_id
 276       shippingpoint
 277       shipto_id
 278       shipvia
 279       taxincluded
 280       taxzone_id
 281       transdate
 282       transaction_description
 283       vendor_confirmation_number
 284       vendor_id
 285     );
 286     # }}} for vim folds
 287   }
 288
 289   # Custom shipto addresses (the ones specific to the sales/purchase
 290   # record and not to the customer/vendor) are only linked from
 291   # shipto → delivery_orders. Meaning delivery_orders.shipto_id
 292   # will not be filled in that case.
 293   if (!$source->shipto_id && $source->id) {
 294     $record_args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
 295   } else {
 296     $record_args{shipto_id} = $source->shipto_id;
 297   }
 298
 299   # infer type from legacy fields if not given
 300   $record_args{record_type} //= $source->customer_id ? SALES_DELIVERY_ORDER_TYPE()
 301                               : $source->vendor_id   ? PURCHASE_DELIVERY_ORDER_TYPE()
 302                               : $source->is_sales    ? SALES_DELIVERY_ORDER_TYPE()
 303                               : croak "need some way to set delivery order type from source";
 304
 305   my $delivery_order = $class->new(%record_args);
 306   $delivery_order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
 307
 308   my $items = delete($params{items}) || $source->items_sorted;
 309   my @items = ( $delivery_order->is_type(SUPPLIER_DELIVERY_ORDER_TYPE()) && ref($source) ne 'SL::DB::Reclamation' ) ?
 310                 ()
 311               : map { SL::DB::DeliveryOrderItem->new_from($_, %params) } @{ $items };
 312
 313   @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
 314   @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
 315   @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
 316
 317   $delivery_order->items(\@items);
 318
 319   unless ($params{no_linked_records}) {
 320     $delivery_order->{ RECORD_ID() } = $source->id;
 321     $delivery_order->{ RECORD_TYPE_REF() } = ref $source;
 322   }
 323
 324   return $delivery_order;
 325 }
 326
 327 sub new_from_time_recordings {
 328   my ($class, $sources, %params) = @_;
 329   require SL::DB::Part;
 330   require SL::DB::Unit;
 331
 332   croak("Unsupported object type in sources")                                      if any { ref($_) ne 'SL::DB::TimeRecording' }            @$sources;
 333   croak("Cannot create delivery order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
 334
 335   # - one item per part (article)
 336   # - qty is sum of duration
 337   # - description goes to item longdescription
 338   #  - ordered and summed by date
 339   #  - each description goes to an ordered list
 340   #  - (as time recording descriptions are formatted text by now, use stripped text)
 341   #  - merge same descriptions
 342   #
 343
 344   my $default_part_id  = $params{default_part_id}     ? $params{default_part_id}
 345                        : $params{default_partnumber}  ? SL::DB::Manager::Part->find_by(partnumber => $params{default_partnumber})->id
 346                        : undef;
 347   my $override_part_id = $params{override_part_id}    ? $params{override_part_id}
 348                        : $params{override_partnumber} ? SL::DB::Manager::Part->find_by(partnumber => $params{override_partnumber})->id
 349                        : undef;
 350
 351   # check parts and collect entries
 352   my %part_by_part_id;
 353   my $entries;
 354   foreach my $source (@$sources) {
 355     next if !$source->duration;
 356
 357     my $part_id   = $override_part_id;
 358     $part_id    ||= $source->part_id;
 359     $part_id    ||= $default_part_id;
 360
 361     die 'article not found for entry "' . $source->displayable_times . '"' if !$part_id;
 362
 363     if (!$part_by_part_id{$part_id}) {
 364       $part_by_part_id{$part_id} = SL::DB::Part->new(id => $part_id)->load;
 365       die 'article unit must be time based for entry "' . $source->displayable_times . '"' if !$part_by_part_id{$part_id}->unit_obj->is_time_based;
 366     }
 367
 368     my $date = $source->date->to_kivitendo;
 369     $entries->{$part_id}->{$date}->{duration} += $params{rounding}
 370                                                ? nhimult(0.25, ($source->duration_in_hours))
 371                                                : _round_total($source->duration_in_hours);
 372     # add content if not already in description
 373     my $new_description = '' . $source->description_as_stripped_html;
 374     $entries->{$part_id}->{$date}->{content} ||= '';
 375     $entries->{$part_id}->{$date}->{content}  .= '<li>' . $new_description . '</li>'
 376       unless $entries->{$part_id}->{$date}->{content} =~ m/\Q$new_description/;
 377
 378     $entries->{$part_id}->{$date}->{date_obj}  = $source->start_time || $source->date; # for sorting
 379   }
 380
 381   my @items;
 382
 383   my $h_unit = SL::DB::Manager::Unit->find_h_unit;
 384
 385   my @keys = sort { $part_by_part_id{$a}->partnumber cmp $part_by_part_id{$b}->partnumber } keys %$entries;
 386   foreach my $key (@keys) {
 387     my $qty = 0;
 388     my $longdescription = '';
 389
 390     my @dates = sort { $entries->{$key}->{$a}->{date_obj} <=> $entries->{$key}->{$b}->{date_obj} } keys %{$entries->{$key}};
 391     foreach my $date (@dates) {
 392       my $entry = $entries->{$key}->{$date};
 393
 394       $qty             += $entry->{duration};
 395       $longdescription .= $date . ' <strong>' . _format_total($entry->{duration}) . ' h</strong>';
 396       $longdescription .= '<ul>';
 397       $longdescription .= $entry->{content};
 398       $longdescription .= '</ul>';
 399     }
 400
 401     my $item = SL::DB::DeliveryOrderItem->new(
 402       parts_id        => $part_by_part_id{$key}->id,
 403       description     => $part_by_part_id{$key}->description,
 404       qty             => $qty,
 405       base_qty        => $h_unit->convert_to($qty, $part_by_part_id{$key}->unit_obj),
 406       unit_obj        => $h_unit,
 407       sellprice       => $part_by_part_id{$key}->sellprice, # Todo: use price rules to get sellprice
 408       longdescription => $longdescription,
 409     );
 410
 411     push @items, $item;
 412   }
 413
 414   my $delivery_order;
 415
 416   if ($params{related_order}) {
 417     # collect suitable items in related order
 418     my @items_to_use;
 419     my @new_attributes;
 420     foreach my $item (@items) {
 421       my $item_to_use = first {$item->parts_id == $_->parts_id} @{ $params{related_order}->items_sorted };
 422
 423       die "no suitable item found in related order" if !$item_to_use;
 424
 425       my %new_attributes;
 426       $new_attributes{$_} = $item->$_ for qw(qty base_qty unit_obj longdescription);
 427       push @items_to_use,   $item_to_use;
 428       push @new_attributes, \%new_attributes;
 429     }
 430
 431     $delivery_order = $class->new_from($params{related_order}, items => \@items_to_use, %params);
 432     pairwise { $a->assign_attributes( %$b) } @{$delivery_order->items}, @new_attributes;
 433
 434   } else {
 435     my %args = (
 436       record_type => SALES_DELIVERY_ORDER_TYPE,
 437       delivered   => 0,
 438       customer_id => $sources->[0]->customer_id,
 439       taxzone_id  => $sources->[0]->customer->taxzone_id,
 440       currency_id => $sources->[0]->customer->currency_id,
 441       employee_id => SL::DB::Manager::Employee->current->id,
 442       salesman_id => SL::DB::Manager::Employee->current->id,
 443       items       => \@items,
 444     );
 445     $delivery_order = $class->new(%args);
 446     $delivery_order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
 447   }
 448
 449   return $delivery_order;
 450 }
 451
 452 # legacy for compatibility
 453 # use type_data cusomtervendor and transfer direction instead
 454 sub is_sales {
 455   if ($_[0]->record_type) {
 456    return SL::DB::DeliveryOrder::TypeData::get3($_[0]->record_type, "properties", "is_customer");
 457   }
 458   return $_[0]{is_sales};
 459 }
 460
 461 sub customervendor {
 462   SL::DB::DeliveryOrder::TypeData::get3($_[0]->record_type, "properties", "is_customer") ? $_[0]->customer : $_[0]->vendor;
 463 }
 464
 465 sub convert_to_invoice {
 466   my ($self, %params) = @_;
 467
 468   croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
 469
 470   my $invoice;
 471   if (!$self->db->with_transaction(sub {
 472     require SL::DB::Invoice;
 473     $invoice = SL::DB::Invoice->new_from($self, %params)->post || die;
 474     $self->update_attributes(closed => 1);
 475     1;
 476   })) {
 477     return undef;
 478   }
 479
 480   return $invoice;
 481 }
 482
 483 sub digest {
 484   my ($self) = @_;
 485
 486   sprintf "%s %s (%s)",
 487     $self->donumber,
 488     $self->customervendor->name,
 489     $self->date->to_kivitendo;
 490 }
 491
 492 sub type_data {
 493   SL::DB::Helper::TypeDataProxy->new(ref $_[0], $_[0]->type);
 494 }
 495
 496 1;
 497 __END__
 498
 499 =pod
 500
 501 =encoding utf8
 502
 503 =head1 NAME
 504
 505 SL::DB::DeliveryOrder - Rose model for delivery orders (table
 506 "delivery_orders")
 507
 508 =head1 FUNCTIONS
 509
 510 =over 4
 511
 512 =item C<date>
 513
 514 An alias for C<transdate> for compatibility with other sales/purchase models.
 515
 516 =item C<displayable_name>
 517
 518 Returns a human-readable and translated description of the delivery order, consisting of
 519 record type and number, e.g. "Verkaufslieferschein 123".
 520
 521 =item C<displayable_state>
 522
 523 Returns a human-readable description of the state regarding being
 524 closed and delivered.
 525
 526 =item C<items>
 527
 528 An alias for C<delivery_order_items> for compatibility with other
 529 sales/purchase models.
 530
 531 =item C<new_from $source, %params>
 532
 533 Creates a new C<SL::DB::DeliveryOrder> instance and copies as much
 534 information from C<$source> as possible. At the moment only instances
 535 of C<SL::DB::Order> (sales quotations, sales orders, requests for
 536 quotations and purchase orders) are supported as sources.
 537
 538 The conversion copies order items into delivery order items. Dates are copied
 539 as appropriate, e.g. the C<transdate> field will be set to the current date.
 540
 541 Returns the new delivery order instance. The object returned is not
 542 saved.
 543
 544 C<%params> can include the following options:
 545
 546 =over 2
 547
 548 =item C<items>
 549
 550 An optional array reference of RDBO instances for the items to use. If
 551 missing then the method C<items_sorted> will be called on
 552 C<$source>. This option can be used to override the sorting, to
 553 exclude certain positions or to add additional ones.
 554
 555 =item C<skip_items_negative_qty>
 556
 557 If trueish then items with a negative quantity are skipped. Items with
 558 a quantity of 0 are not affected by this option.
 559
 560 =item C<skip_items_zero_qty>
 561
 562 If trueish then items with a quantity of 0 are skipped.
 563
 564 =item C<item_filter>
 565
 566 An optional code reference that is called for each item with the item
 567 as its sole parameter. Items for which the code reference returns a
 568 falsish value will be skipped.
 569
 570 =item C<attributes>
 571
 572 An optional hash reference. If it exists then it is passed to C<new>
 573 allowing the caller to set certain attributes for the new delivery
 574 order.
 575
 576 =back
 577
 578 =item C<new_from_time_recordings $sources, %params>
 579
 580 Creates a new C<SL::DB::DeliveryOrder> instance from the time recordings
 581 given as C<$sources>. All time recording entries must belong to the same
 582 customer. Time recordings are sorted by article and date. For each article
 583 a new delivery order item is created. If no article is associated with an
 584 entry, a default article will be used. The article given in the time
 585 recording entry can be overriden.
 586 Entries of the same date (for each article) are summed together and form a
 587 list entry in the long description of the item.
 588
 589 The created delivery order object will be returnd but not saved.
 590
 591 C<$sources> must be an array reference of C<SL::DB::TimeRecording> instances.
 592
 593 C<%params> can include the following options:
 594
 595 =over 2
 596
 597 =item C<attributes>
 598
 599 An optional hash reference. If it exists then it is used to set
 600 attributes of the newly created delivery order object.
 601
 602 =item C<default_part_id>
 603
 604 An optional part id which is used as default value if no part is set
 605 in the time recording entry.
 606
 607 =item C<default_partnumber>
 608
 609 Like C<default_part_id> but given as partnumber, not as id.
 610
 611 =item C<override_part_id>
 612
 613 An optional part id which is used instead of a value set in the time
 614 recording entry.
 615
 616 =item C<override_partnumber>
 617
 618 Like C<overrride_part_id> but given as partnumber, not as id.
 619
 620 =item C<related_order>
 621
 622 An optional C<SL::DB::Order> object. If it exists then it is used to
 623 generate the delivery order from that via C<new_from>.
 624 The generated items are created from a suitable item of the related
 625 order. If no suitable item is found, an exception is thrown.
 626
 627 =item C<rounding>
 628
 629 An optional boolean value. If truish, then the durations of the time entries
 630 are rounded up to the full quarters of an hour.
 631
 632 =back
 633
 634 =item C<sales_order>
 635
 636 TODO: Describe sales_order
 637
 638 =item C<type>
 639
 640 Returns a string describing this record's type: either
 641 C<sales_delivery_order> or C<purchase_delivery_order>.
 642
 643 =item C<convert_to_invoice %params>
 644
 645 Creates a new invoice with C<$self> as the basis by calling
 646 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
 647 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
 648 C<closed> attribute is set to C<true>, and C<$self> is saved.
 649
 650 The arguments in C<%params> are passed to L<SL::DB::Invoice::new_from>.
 651
 652 Returns the new invoice instance on success and C<undef> on
 653 failure. The whole process is run inside a transaction. On failure
 654 nothing is created or changed in the database.
 655
 656 At the moment only sales delivery orders can be converted.
 657
 658 =back
 659
 660 =head1 BUGS
 661
 662 Nothing here yet.
 663
 664 =head1 AUTHOR
 665
 666 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 667
 668 =cut