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