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