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