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 notall);
  23 use List::MoreUtils qw(any);
  24
  25 __PACKAGE__->meta->add_relationship(orderitems => { type         => 'one to many',
  26                                                     class        => 'SL::DB::DeliveryOrderItem',
  27                                                     column_map   => { id => 'delivery_order_id' },
  28                                                     manager_args => { with_objects => [ 'part' ] }
  29                                                   },
  30                                     custom_shipto => {
  31                                       type        => 'one to one',
  32                                       class       => 'SL::DB::Shipto',
  33                                       column_map  => { id => 'trans_id' },
  34                                       query_args  => [ module => 'DO' ],
  35                                     },
  36                                    );
  37
  38 __PACKAGE__->meta->initialize;
  39
  40 __PACKAGE__->attr_html('notes');
  41 __PACKAGE__->attr_sorted('items');
  42
  43 __PACKAGE__->before_save('_before_save_set_donumber');
  44
  45 # hooks
  46
  47 sub _before_save_set_donumber {
  48   my ($self) = @_;
  49
  50   $self->create_trans_number if !$self->donumber;
  51
  52   return 1;
  53 }
  54
  55 # methods
  56
  57 sub items { goto &orderitems; }
  58 sub add_items { goto &add_orderitems; }
  59 sub payment_terms { goto &payment; }
  60 sub record_number { goto &donumber; }
  61
  62 sub sales_order {
  63   my $self   = shift;
  64   my %params = @_;
  65
  66
  67   require SL::DB::Order;
  68   my $orders = SL::DB::Manager::Order->get_all(
  69     query => [
  70       ordnumber => $self->ordnumber,
  71       @{ $params{query} || [] },
  72     ],
  73   );
  74
  75   return first { $_->is_type('sales_order') } @{ $orders };
  76 }
  77
  78 sub type {
  79   return shift->customer_id ? 'sales_delivery_order' : 'purchase_delivery_order';
  80 }
  81
  82 sub displayable_type {
  83   my $type = shift->type;
  84
  85   return $::locale->text('Sales Delivery Order')    if $type eq 'sales_delivery_order';
  86   return $::locale->text('Purchase Delivery Order') if $type eq 'purchase_delivery_order';
  87
  88   die 'invalid type';
  89 }
  90
  91 sub displayable_name {
  92   join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
  93 };
  94
  95 sub displayable_state {
  96   my ($self) = @_;
  97
  98   return join '; ',
  99     ($self->closed    ? $::locale->text('closed')    : $::locale->text('open')),
 100     ($self->delivered ? $::locale->text('delivered') : $::locale->text('not delivered'));
 101 }
 102
 103 sub date {
 104   goto &transdate;
 105 }
 106
 107 sub _clone_orderitem_cvar {
 108   my ($cvar) = @_;
 109
 110   my $cloned = $_->clone_and_reset;
 111   $cloned->sub_module('delivery_order_items');
 112
 113   return $cloned;
 114 }
 115
 116 sub new_from {
 117   my ($class, $source, %params) = @_;
 118
 119   croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
 120
 121   my ($item_parent_id_column, $item_parent_column);
 122
 123   if (ref($source) eq 'SL::DB::Order') {
 124     $item_parent_id_column = 'trans_id';
 125     $item_parent_column    = 'order';
 126   }
 127
 128   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
 129                                                 ordnumber payment_id reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id transaction_description vendor_id
 130                                              )),
 131                closed    => 0,
 132                is_sales  => !!$source->customer_id,
 133                delivered => 0,
 134                transdate => DateTime->today_local,
 135             );
 136
 137   # Custom shipto addresses (the ones specific to the sales/purchase
 138   # record and not to the customer/vendor) are only linked from
 139   # shipto → delivery_orders. Meaning delivery_orders.shipto_id
 140   # will not be filled in that case.
 141   if (!$source->shipto_id && $source->id) {
 142     $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
 143
 144   } else {
 145     $args{shipto_id} = $source->shipto_id;
 146   }
 147
 148   my $delivery_order = $class->new(%args);
 149   $delivery_order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
 150   my $items          = delete($params{items}) || $source->items_sorted;
 151   my %item_parents;
 152
 153   my @items = map {
 154     my $source_item      = $_;
 155     my $source_item_id   = $_->$item_parent_id_column;
 156     my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
 157
 158     $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
 159     my $item_parent                  = $item_parents{$source_item_id};
 160
 161     my $current_do_item = SL::DB::DeliveryOrderItem->new(map({ ( $_ => $source_item->$_ ) }
 162                                          qw(base_qty cusordnumber description discount lastcost longdescription marge_price_factor parts_id price_factor price_factor_id
 163                                             project_id qty reqdate sellprice serialnumber transdate unit active_discount_source active_price_source
 164                                          )),
 165                                    custom_variables => \@custom_variables,
 166                                    ordnumber        => ref($item_parent) eq 'SL::DB::Order' ? $item_parent->ordnumber : $source_item->ordnumber,
 167                                  );
 168     $current_do_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
 169     $current_do_item;
 170   } @{ $items };
 171
 172   @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
 173   @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
 174   @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
 175
 176   $delivery_order->items(\@items);
 177
 178   return $delivery_order;
 179 }
 180
 181 sub new_from_time_recordings {
 182   my ($class, $sources, %params) = @_;
 183
 184   croak("Unsupported object type in sources")                                      if any { ref($_) ne 'SL::DB::TimeRecording' }            @$sources;
 185   croak("Cannot create delivery order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
 186
 187   my %args = (
 188     is_sales    => 1,
 189     delivered   => 1,
 190     customer_id => $sources->[0]->customer_id,
 191     taxzone_id  => $sources->[0]->customer->taxzone_id,
 192     currency_id => $sources->[0]->customer->currency_id,
 193     employee_id => SL::DB::Manager::Employee->current->id,
 194     salesman_id => SL::DB::Manager::Employee->current->id,
 195     items       => [],
 196   );
 197   my $delivery_order = $class->new(%args);
 198   $delivery_order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
 199
 200   # - one item per part (article)
 201   # - qty is sum of duration
 202   # - description goes to item longdescription
 203   #  - ordered and summed by date
 204   #  - each description goes to an ordered list
 205   #  - (as time recording descriptions are formatted text by now, use stripped text)
 206   #  - merge same descriptions (todo)
 207   #
 208
 209   ### config
 210   my $default_partnummer = 6;
 211   my $default_part_id    = SL::DB::Manager::Part->find_by(partnumber => $default_partnummer)->id;
 212
 213   # check parts and collect entries
 214   my %part_by_part_id;
 215   my $entries;
 216   foreach my $source (@$sources) {
 217     my $part_id  = $source->part_id ? $source->part_id
 218                  : $default_part_id ? $default_part_id
 219                  : undef;
 220
 221     die 'article not found for entry "' . $source->displayable_times . '"' if !$part_id;
 222
 223     if (!$part_by_part_id{$part_id}) {
 224       $part_by_part_id{$part_id} = SL::DB::Part->new(id => $part_id)->load;
 225       die 'article unit must be time based for entry "' . $source->displayable_times . '"' if !$part_by_part_id{$part_id}->unit_obj->is_time_based;
 226     }
 227
 228     my $date = $source->start_time->to_kivitendo;
 229     $entries->{$part_id}->{$date}->{duration} += _round_total($source->duration_in_hours);
 230     $entries->{$part_id}->{$date}->{content}  .= '<li>' . $source->description_as_stripped_html . '</li>';
 231     $entries->{$part_id}->{$date}->{date_obj}  = $source->start_time; # for sorting
 232   }
 233
 234   my $h_unit = SL::DB::Manager::Unit->find_h_unit;
 235
 236   my @keys = sort { $part_by_part_id{$a}->partnumber cmp $part_by_part_id{$b}->partnumber } keys %$entries;
 237   foreach my $key (@keys) {
 238     my $qty = 0;
 239     my $longdescription = '';
 240
 241     my @dates = sort { $entries->{$key}->{$a}->{date_obj} <=> $entries->{$key}->{$b}->{date_obj} } keys %{$entries->{$key}};
 242     foreach my $date (@dates) {
 243       my $entry = $entries->{$key}->{$date};
 244
 245       $qty             += $entry->{duration};
 246       $longdescription .= $date . ' <strong>' . _format_total($entry->{duration}) . ' h</strong>';
 247       $longdescription .= '<ul>';
 248       $longdescription .= $entry->{content};
 249       $longdescription .= '</ul>';
 250     }
 251
 252     my $item = SL::DB::DeliveryOrderItem->new(
 253       parts_id        => $part_by_part_id{$key}->id,
 254       description     => $part_by_part_id{$key}->description,
 255       qty             => $qty,
 256       unit_obj        => $h_unit,
 257       sellprice       => $part_by_part_id{$key}->sellprice,
 258       longdescription => $longdescription,
 259     );
 260
 261     $delivery_order->add_items($item);
 262   }
 263
 264   return $delivery_order;
 265 }
 266
 267 sub customervendor {
 268   $_[0]->is_sales ? $_[0]->customer : $_[0]->vendor;
 269 }
 270
 271 sub convert_to_invoice {
 272   my ($self, %params) = @_;
 273
 274   croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
 275
 276   my $invoice;
 277   if (!$self->db->with_transaction(sub {
 278     require SL::DB::Invoice;
 279     $invoice = SL::DB::Invoice->new_from($self, %params)->post || die;
 280     $self->link_to_record($invoice);
 281     # TODO extend link_to_record for items, otherwise long-term no d.r.y.
 282     foreach my $item (@{ $invoice->items }) {
 283       foreach (qw(delivery_order_items)) {    # expand if needed (orderitems)
 284         if ($item->{"converted_from_${_}_id"}) {
 285           die unless $item->{id};
 286           RecordLinks->create_links('mode'       => 'ids',
 287                                     'from_table' => $_,
 288                                     'from_ids'   => $item->{"converted_from_${_}_id"},
 289                                     'to_table'   => 'invoice',
 290                                     'to_id'      => $item->{id},
 291           ) || die;
 292           delete $item->{"converted_from_${_}_id"};
 293         }
 294       }
 295     }
 296     $self->update_attributes(closed => 1);
 297     1;
 298   })) {
 299     return undef;
 300   }
 301
 302   return $invoice;
 303 }
 304
 305 sub digest {
 306   my ($self) = @_;
 307
 308   sprintf "%s %s (%s)",
 309     $self->donumber,
 310     $self->customervendor->name,
 311     $self->date->to_kivitendo;
 312 }
 313
 314 1;
 315 __END__
 316
 317 =pod
 318
 319 =encoding utf8
 320
 321 =head1 NAME
 322
 323 SL::DB::DeliveryOrder - Rose model for delivery orders (table
 324 "delivery_orders")
 325
 326 =head1 FUNCTIONS
 327
 328 =over 4
 329
 330 =item C<date>
 331
 332 An alias for C<transdate> for compatibility with other sales/purchase models.
 333
 334 =item C<displayable_name>
 335
 336 Returns a human-readable and translated description of the delivery order, consisting of
 337 record type and number, e.g. "Verkaufslieferschein 123".
 338
 339 =item C<displayable_state>
 340
 341 Returns a human-readable description of the state regarding being
 342 closed and delivered.
 343
 344 =item C<items>
 345
 346 An alias for C<delivery_order_items> for compatibility with other
 347 sales/purchase models.
 348
 349 =item C<new_from $source, %params>
 350
 351 Creates a new C<SL::DB::DeliveryOrder> instance and copies as much
 352 information from C<$source> as possible. At the moment only instances
 353 of C<SL::DB::Order> (sales quotations, sales orders, requests for
 354 quotations and purchase orders) are supported as sources.
 355
 356 The conversion copies order items into delivery order items. Dates are copied
 357 as appropriate, e.g. the C<transdate> field will be set to the current date.
 358
 359 Returns the new delivery order instance. The object returned is not
 360 saved.
 361
 362 C<%params> can include the following options:
 363
 364 =over 2
 365
 366 =item C<items>
 367
 368 An optional array reference of RDBO instances for the items to use. If
 369 missing then the method C<items_sorted> will be called on
 370 C<$source>. This option can be used to override the sorting, to
 371 exclude certain positions or to add additional ones.
 372
 373 =item C<skip_items_negative_qty>
 374
 375 If trueish then items with a negative quantity are skipped. Items with
 376 a quantity of 0 are not affected by this option.
 377
 378 =item C<skip_items_zero_qty>
 379
 380 If trueish then items with a quantity of 0 are skipped.
 381
 382 =item C<item_filter>
 383
 384 An optional code reference that is called for each item with the item
 385 as its sole parameter. Items for which the code reference returns a
 386 falsish value will be skipped.
 387
 388 =item C<attributes>
 389
 390 An optional hash reference. If it exists then it is passed to C<new>
 391 allowing the caller to set certain attributes for the new delivery
 392 order.
 393
 394 =back
 395
 396 =item C<new_from_time_recordings $sources, %params>
 397
 398 Creates a new C<SL::DB::DeliveryOrder> instace from the time recordings
 399 given as C<$sources>. All time recording entries must belong to the same
 400 customer. Time recordings are sorted by article and date. For each article
 401 a new delivery order item is created. If no article is associated with an
 402 entry, a default article will be used (hard coded).
 403 Entries of the same date (for each article) are summed together and form a
 404 list entry in the long description of the item.
 405
 406 The created delivery order object will be returnd but not saved.
 407
 408 C<$sources> must be an array reference of C<SL::DB::TimeRecording> instances.
 409
 410 C<%params> can include the following options:
 411
 412 =over 2
 413
 414 =item C<attributes>
 415
 416 An optional hash reference. If it exists then it is used to set
 417 attributes of the newly created delivery order object.
 418
 419 =back
 420
 421 =item C<sales_order>
 422
 423 TODO: Describe sales_order
 424
 425 =item C<type>
 426
 427 Returns a string describing this record's type: either
 428 C<sales_delivery_order> or C<purchase_delivery_order>.
 429
 430 =item C<convert_to_invoice %params>
 431
 432 Creates a new invoice with C<$self> as the basis by calling
 433 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
 434 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
 435 C<closed> attribute is set to C<true>, and C<$self> is saved.
 436
 437 The arguments in C<%params> are passed to L<SL::DB::Invoice::new_from>.
 438
 439 Returns the new invoice instance on success and C<undef> on
 440 failure. The whole process is run inside a transaction. On failure
 441 nothing is created or changed in the database.
 442
 443 At the moment only sales delivery orders can be converted.
 444
 445 =back
 446
 447 =head1 BUGS
 448
 449 Nothing here yet.
 450
 451 =head1 AUTHOR
 452
 453 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 454
 455 =cut