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