SL/DB/Order.pm

   1 package SL::DB::Order;
   2
   3 use utf8;
   4 use strict;
   5
   6 use Carp;
   7 use DateTime;
   8 use List::Util qw(max);
   9 use List::MoreUtils qw(any);
  10
  11 use SL::DB::MetaSetup::Order;
  12 use SL::DB::Manager::Order;
  13 use SL::DB::Helper::AttrHTML;
  14 use SL::DB::Helper::AttrSorted;
  15 use SL::DB::Helper::FlattenToForm;
  16 use SL::DB::Helper::LinkedRecords;
  17 use SL::DB::Helper::PriceTaxCalculator;
  18 use SL::DB::Helper::PriceUpdater;
  19 use SL::DB::Helper::TransNumberGenerator;
  20 use SL::RecordLinks;
  21 use Rose::DB::Object::Helpers qw(as_tree);
  22
  23 __PACKAGE__->meta->add_relationship(
  24   orderitems => {
  25     type         => 'one to many',
  26     class        => 'SL::DB::OrderItem',
  27     column_map   => { id => 'trans_id' },
  28     manager_args => {
  29       with_objects => [ 'part' ]
  30     }
  31   },
  32   periodic_invoices_config => {
  33     type                   => 'one to one',
  34     class                  => 'SL::DB::PeriodicInvoicesConfig',
  35     column_map             => { id => 'oe_id' },
  36   },
  37   custom_shipto            => {
  38     type                   => 'one to one',
  39     class                  => 'SL::DB::Shipto',
  40     column_map             => { id => 'trans_id' },
  41     query_args             => [ module => 'OE' ],
  42   },
  43 );
  44
  45 __PACKAGE__->meta->initialize;
  46
  47 __PACKAGE__->attr_html('notes');
  48 __PACKAGE__->attr_sorted('items');
  49
  50 __PACKAGE__->before_save('_before_save_set_ord_quo_number');
  51
  52 # hooks
  53
  54 sub _before_save_set_ord_quo_number {
  55   my ($self) = @_;
  56
  57   # ordnumber is 'NOT NULL'. Therefore make sure it's always set to at
  58   # least an empty string, even if we're saving a quotation.
  59   $self->ordnumber('') if !$self->ordnumber;
  60
  61   my $field = $self->quotation ? 'quonumber' : 'ordnumber';
  62   $self->create_trans_number if !$self->$field;
  63
  64   return 1;
  65 }
  66
  67 # methods
  68
  69 sub items { goto &orderitems; }
  70 sub add_items { goto &add_orderitems; }
  71 sub record_number { goto &number; }
  72
  73 sub type {
  74   my $self = shift;
  75
  76   return 'sales_order'       if $self->customer_id && ! $self->quotation;
  77   return 'purchase_order'    if $self->vendor_id   && ! $self->quotation;
  78   return 'sales_quotation'   if $self->customer_id &&   $self->quotation;
  79   return 'request_quotation' if $self->vendor_id   &&   $self->quotation;
  80
  81   return;
  82 }
  83
  84 sub is_type {
  85   return shift->type eq shift;
  86 }
  87
  88 sub deliverydate {
  89   # oe doesn't have deliverydate, but PTC checks for deliverydate or transdate to determine tax
  90   # oe can't deal with deviating tax rates, but at least make sure PTC doesn't barf
  91   return shift->transdate;
  92 }
  93
  94 sub displayable_type {
  95   my $type = shift->type;
  96
  97   return $::locale->text('Sales quotation')   if $type eq 'sales_quotation';
  98   return $::locale->text('Request quotation') if $type eq 'request_quotation';
  99   return $::locale->text('Sales Order')       if $type eq 'sales_order';
 100   return $::locale->text('Purchase Order')    if $type eq 'purchase_order';
 101
 102   die 'invalid type';
 103 }
 104
 105 sub displayable_name {
 106   join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
 107 };
 108
 109 sub is_sales {
 110   croak 'not an accessor' if @_ > 1;
 111   return !!shift->customer_id;
 112 }
 113
 114 sub invoices {
 115   my $self   = shift;
 116   my %params = @_;
 117
 118   if ($self->quotation) {
 119     return [];
 120   } else {
 121     require SL::DB::Invoice;
 122     return SL::DB::Manager::Invoice->get_all(
 123       query => [
 124         ordnumber => $self->ordnumber,
 125         @{ $params{query} || [] },
 126       ]
 127     );
 128   }
 129 }
 130
 131 sub displayable_state {
 132   my ($self) = @_;
 133
 134   return $self->closed ? $::locale->text('closed') : $::locale->text('open');
 135 }
 136
 137 sub abschlag_invoices {
 138   return shift()->invoices(query => [ abschlag => 1 ]);
 139 }
 140
 141 sub end_invoice {
 142   return shift()->invoices(query => [ abschlag => 0 ]);
 143 }
 144
 145 sub convert_to_invoice {
 146   my ($self, %params) = @_;
 147
 148   croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
 149
 150   my $invoice;
 151   if (!$self->db->with_transaction(sub {
 152     require SL::DB::Invoice;
 153     $invoice = SL::DB::Invoice->new_from($self)->post(%params) || die;
 154     $self->link_to_record($invoice);
 155     $self->update_attributes(closed => 1);
 156     1;
 157   })) {
 158     return undef;
 159   }
 160
 161   return $invoice;
 162 }
 163
 164 sub convert_to_delivery_order {
 165   my ($self, @args) = @_;
 166
 167   my $delivery_order;
 168   if (!$self->db->with_transaction(sub {
 169     require SL::DB::DeliveryOrder;
 170     $delivery_order = SL::DB::DeliveryOrder->new_from($self, @args);
 171     $delivery_order->save;
 172     $self->link_to_record($delivery_order);
 173     # TODO extend link_to_record for items, otherwise long-term no d.r.y.
 174     foreach my $item (@{ $delivery_order->items }) {
 175       foreach (qw(orderitems)) {    # expand if needed (delivery_order_items)
 176         if ($item->{"converted_from_${_}_id"}) {
 177           die unless $item->{id};
 178           RecordLinks->create_links('dbh'        => $self->db->dbh,
 179                                     'mode'       => 'ids',
 180                                     'from_table' => $_,
 181                                     'from_ids'   => $item->{"converted_from_${_}_id"},
 182                                     'to_table'   => 'delivery_order_items',
 183                                     'to_id'      => $item->{id},
 184           ) || die;
 185           delete $item->{"converted_from_${_}_id"};
 186         }
 187       }
 188     }
 189
 190     $self->update_attributes(delivered => 1);
 191     1;
 192   })) {
 193     return undef;
 194   }
 195
 196   return $delivery_order;
 197 }
 198
 199 sub _clone_orderitem_cvar {
 200   my ($cvar) = @_;
 201
 202   my $cloned = $_->clone_and_reset;
 203   $cloned->sub_module('orderitems');
 204
 205   return $cloned;
 206 }
 207
 208 sub new_from {
 209   my ($class, $source, %params) = @_;
 210
 211   croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
 212   croak("A destination type must be given as parameter")         unless $params{destination_type};
 213
 214   my $destination_type  = delete $params{destination_type};
 215
 216   my @from_tos = (
 217     { from => 'sales_quotation',   to => 'sales_order',       abbr => 'sqso' },
 218     { from => 'request_quotation', to => 'purchase_order',    abbr => 'rqpo' },
 219     { from => 'sales_quotation',   to => 'sales_quotation',   abbr => 'sqsq' },
 220     { from => 'sales_order',       to => 'sales_order',       abbr => 'soso' },
 221     { from => 'request_quotation', to => 'request_quotation', abbr => 'rqrq' },
 222     { from => 'purchase_order',    to => 'purchase_order',    abbr => 'popo' },
 223     { from => 'sales_order',       to => 'purchase_order',    abbr => 'sopo' },
 224     { from => 'purchase_order',    to => 'sales_order',       abbr => 'poso' },
 225   );
 226   my $from_to = (grep { $_->{from} eq $source->type && $_->{to} eq $destination_type} @from_tos)[0];
 227   croak("Cannot convert from '" . $source->type . "' to '" . $destination_type . "'") if !$from_to;
 228
 229   my $is_abbr_any = sub {
 230     # foreach my $abbr (@_) {
 231     #   croak "no such abbreviation: '$abbr'" if !grep { $_->{abbr} eq $abbr } @from_tos;
 232     # }
 233     any { $from_to->{abbr} eq $_ } @_;
 234   };
 235
 236   my ($item_parent_id_column, $item_parent_column);
 237
 238   if (ref($source) eq 'SL::DB::Order') {
 239     $item_parent_id_column = 'trans_id';
 240     $item_parent_column    = 'order';
 241   }
 242
 243   my %args = ( map({ ( $_ => $source->$_ ) } qw(amount cp_id currency_id cusordnumber customer_id delivery_customer_id delivery_term_id delivery_vendor_id
 244                                                 department_id employee_id globalproject_id intnotes marge_percent marge_total language_id netamount notes
 245                                                 ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id
 246                                                 transaction_description vendor_id
 247                                              )),
 248                quotation => !!($destination_type =~ m{quotation$}),
 249                closed    => 0,
 250                delivered => 0,
 251                transdate => DateTime->today_local,
 252             );
 253
 254   if ( $is_abbr_any->(qw(sopo poso)) ) {
 255     $args{ordnumber} = undef;
 256     $args{reqdate}   = DateTime->today_local->next_workday();
 257     $args{employee}  = SL::DB::Manager::Employee->current;
 258   }
 259   if ( $is_abbr_any->(qw(sopo)) ) {
 260     $args{customer_id}      = undef;
 261     $args{salesman_id}      = undef;
 262     $args{payment_id}       = undef;
 263     $args{delivery_term_id} = undef;
 264   }
 265   if ( $is_abbr_any->(qw(poso)) ) {
 266     $args{vendor_id} = undef;
 267   }
 268   if ( $is_abbr_any->(qw(soso)) ) {
 269     $args{periodic_invoices_config} = $source->periodic_invoices_config->clone_and_reset if $source->periodic_invoices_config;
 270   }
 271
 272   # Custom shipto addresses (the ones specific to the sales/purchase
 273   # record and not to the customer/vendor) are only linked from
 274   # shipto → order. Meaning order.shipto_id
 275   # will not be filled in that case.
 276   if (!$source->shipto_id && $source->id) {
 277     $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
 278
 279   } else {
 280     $args{shipto_id} = $source->shipto_id;
 281   }
 282
 283   my $order = $class->new(%args);
 284   $order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
 285   my $items = delete($params{items}) || $source->items_sorted;
 286
 287   my %item_parents;
 288
 289   my @items = map {
 290     my $source_item      = $_;
 291     my $source_item_id   = $_->$item_parent_id_column;
 292     my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
 293
 294     $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
 295     my $item_parent                  = $item_parents{$source_item_id};
 296
 297     my $current_oe_item = SL::DB::OrderItem->new(map({ ( $_ => $source_item->$_ ) }
 298                                                      qw(active_discount_source active_price_source base_qty cusordnumber
 299                                                         description discount lastcost longdescription
 300                                                         marge_percent marge_price_factor marge_total
 301                                                         ordnumber parts_id price_factor price_factor_id pricegroup_id
 302                                                         project_id qty reqdate sellprice serialnumber ship subtotal transdate unit
 303                                                      )),
 304                                                  custom_variables => \@custom_variables,
 305     );
 306     if ( $is_abbr_any->(qw(sopo)) ) {
 307       $current_oe_item->sellprice($source_item->lastcost);
 308       $current_oe_item->discount(0);
 309     }
 310     if ( $is_abbr_any->(qw(poso)) ) {
 311       $current_oe_item->lastcost($source_item->sellprice);
 312     }
 313     $current_oe_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
 314     $current_oe_item;
 315   } @{ $items };
 316
 317   @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
 318   @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
 319   @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
 320
 321   $order->items(\@items);
 322
 323   return $order;
 324 }
 325
 326 sub new_from_multi {
 327   my ($class, $sources, %params) = @_;
 328
 329   croak("Unsupported object type in sources")                             if any { ref($_) !~ m{SL::DB::Order} }                   @$sources;
 330   croak("Cannot create order for purchase records")                       if any { !$_->is_sales }                                 @$sources;
 331   croak("Cannot create order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
 332
 333   # bb: todo: check shipto: is it enough to check the ids or do we have to compare the entries?
 334   if (delete $params{check_same_shipto}) {
 335     die "check same shipto address is not implemented yet";
 336     die "Source records do not have the same shipto"        if 1;
 337   }
 338
 339   # sort sources
 340   if (defined $params{sort_sources_by}) {
 341     my $sort_by = delete $params{sort_sources_by};
 342     if ($sources->[0]->can($sort_by)) {
 343       $sources = [ sort { $a->$sort_by cmp $b->$sort_by } @$sources ];
 344     } else {
 345       die "Cannot sort source records by $sort_by";
 346     }
 347   }
 348
 349   # set this entries to undef that yield different information
 350   my %attributes;
 351   foreach my $attr (qw(ordnumber transdate reqdate taxincluded shippingpoint
 352                        shipvia notes closed delivered reqdate quonumber
 353                        cusordnumber proforma transaction_description
 354                        order_probability expected_billing_date)) {
 355     $attributes{$attr} = undef if any { ($sources->[0]->$attr//'') ne ($_->$attr//'') } @$sources;
 356   }
 357   foreach my $attr (qw(cp_id currency_id employee_id salesman_id department_id
 358                        delivery_customer_id delivery_vendor_id shipto_id
 359                        globalproject_id)) {
 360     $attributes{$attr} = undef if any { ($sources->[0]->$attr||0) != ($_->$attr||0) }   @$sources;
 361   }
 362
 363   # set this entries from customer that yield different information
 364   foreach my $attr (qw(language_id taxzone_id payment_id delivery_term_id)) {
 365     $attributes{$attr}  = $sources->[0]->customervendor->$attr if any { ($sources->[0]->$attr||0)     != ($_->$attr||0) }      @$sources;
 366   }
 367   $attributes{intnotes} = $sources->[0]->customervendor->notes if any { ($sources->[0]->intnotes//'') ne ($_->intnotes//'')  } @$sources;
 368
 369   # no periodic invoice config for new order
 370   $attributes{periodic_invoices_config} = undef;
 371
 372   # copy global ordnumber, transdate, cusordnumber into item scope
 373   #   unless already present there
 374   foreach my $attr (qw(ordnumber transdate cusordnumber)) {
 375     foreach my $src (@$sources) {
 376       foreach my $item (@{ $src->items_sorted }) {
 377         $item->$attr($src->$attr) if !$item->$attr;
 378       }
 379     }
 380   }
 381
 382   # collect items
 383   my @items;
 384   push @items, @{$_->items_sorted} for @$sources;
 385   # make order from first source and all items
 386   my $order = $class->new_from($sources->[0],
 387                                destination_type => 'sales_order',
 388                                attributes       => \%attributes,
 389                                items            => \@items,
 390                                %params);
 391
 392   return $order;
 393 }
 394
 395 sub number {
 396   my $self = shift;
 397
 398   return if !$self->type;
 399
 400   my %number_method = (
 401     sales_order       => 'ordnumber',
 402     sales_quotation   => 'quonumber',
 403     purchase_order    => 'ordnumber',
 404     request_quotation => 'quonumber',
 405   );
 406
 407   return $self->${ \ $number_method{$self->type} }(@_);
 408 }
 409
 410 sub customervendor {
 411   $_[0]->is_sales ? $_[0]->customer : $_[0]->vendor;
 412 }
 413
 414 sub date {
 415   goto &transdate;
 416 }
 417
 418 sub digest {
 419   my ($self) = @_;
 420
 421   sprintf "%s %s %s (%s)",
 422     $self->number,
 423     $self->customervendor->name,
 424     $self->amount_as_number,
 425     $self->date->to_kivitendo;
 426 }
 427
 428 1;
 429
 430 __END__
 431
 432 =pod
 433
 434 =encoding utf8
 435
 436 =head1 NAME
 437
 438 SL::DB::Order - Order Datenbank Objekt.
 439
 440 =head1 FUNCTIONS
 441
 442 =head2 C<type>
 443
 444 Returns one of the following string types:
 445
 446 =over 4
 447
 448 =item sales_order
 449
 450 =item purchase_order
 451
 452 =item sales_quotation
 453
 454 =item request_quotation
 455
 456 =back
 457
 458 =head2 C<is_type TYPE>
 459
 460 Returns true if the order is of the given type.
 461
 462 =head2 C<convert_to_delivery_order %params>
 463
 464 Creates a new delivery order with C<$self> as the basis by calling
 465 L<SL::DB::DeliveryOrder::new_from>. That delivery order is saved, and
 466 C<$self> is linked to the new invoice via
 467 L<SL::DB::RecordLink>. C<$self>'s C<delivered> attribute is set to
 468 C<true>, and C<$self> is saved.
 469
 470 The arguments in C<%params> are passed to
 471 L<SL::DB::DeliveryOrder::new_from>.
 472
 473 Returns C<undef> on failure. Otherwise the new delivery order will be
 474 returned.
 475
 476 =head2 C<convert_to_invoice %params>
 477
 478 Creates a new invoice with C<$self> as the basis by calling
 479 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
 480 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
 481 C<closed> attribute is set to C<true>, and C<$self> is saved.
 482
 483 The arguments in C<%params> are passed to L<SL::DB::Invoice::post>.
 484
 485 Returns the new invoice instance on success and C<undef> on
 486 failure. The whole process is run inside a transaction. On failure
 487 nothing is created or changed in the database.
 488
 489 At the moment only sales quotations and sales orders can be converted.
 490
 491 =head2 C<new_from $source, %params>
 492
 493 Creates a new C<SL::DB::Order> instance and copies as much
 494 information from C<$source> as possible. At the moment only records with the
 495 same destination type as the source type and sales orders from
 496 sales quotations and purchase orders from requests for quotations can be
 497 created.
 498
 499 The C<transdate> field will be set to the current date.
 500
 501 The conversion copies the order items as well.
 502
 503 Returns the new order instance. The object returned is not
 504 saved.
 505
 506 C<%params> can include the following options
 507 (C<destination_type> is mandatory):
 508
 509 =over 4
 510
 511 =item C<destination_type>
 512
 513 (mandatory)
 514 The type of the newly created object. Can be C<sales_quotation>,
 515 C<sales_order>, C<purchase_quotation> or C<purchase_order> for now.
 516
 517 =item C<items>
 518
 519 An optional array reference of RDBO instances for the items to use. If
 520 missing then the method C<items_sorted> will be called on
 521 C<$source>. This option can be used to override the sorting, to
 522 exclude certain positions or to add additional ones.
 523
 524 =item C<skip_items_negative_qty>
 525
 526 If trueish then items with a negative quantity are skipped. Items with
 527 a quantity of 0 are not affected by this option.
 528
 529 =item C<skip_items_zero_qty>
 530
 531 If trueish then items with a quantity of 0 are skipped.
 532
 533 =item C<item_filter>
 534
 535 An optional code reference that is called for each item with the item
 536 as its sole parameter. Items for which the code reference returns a
 537 falsish value will be skipped.
 538
 539 =item C<attributes>
 540
 541 An optional hash reference. If it exists then it is passed to C<new>
 542 allowing the caller to set certain attributes for the new delivery
 543 order.
 544
 545 =back
 546
 547 =head2 C<new_from_multi $sources, %params>
 548
 549 Creates a new C<SL::DB::Order> instance from multiple sources and copies as
 550 much information from C<$sources> as possible.
 551 At the moment only sales orders can be combined and they must be of the same
 552 customer.
 553
 554 The new order is created from the first one using C<new_from> and the positions
 555 of all orders are added to the new order. The orders can be sorted with the
 556 parameter C<sort_sources_by>.
 557
 558 The orders attributes are kept if they contain the same information for all
 559 source orders an will be set to empty if they contain different information.
 560
 561 Returns the new order instance. The object returned is not
 562 saved.
 563
 564 C<params> other then C<sort_sources_by> are passed to C<new_from>.
 565
 566 =head1 BUGS
 567
 568 Nothing here yet.
 569
 570 =head1 AUTHOR
 571
 572 Sven Schöling <s.schoeling@linet-services.de>
 573
 574 =cut