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