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