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