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 displayable_type {
  89   my $type = shift->type;
  90
  91   return $::locale->text('Sales quotation')   if $type eq 'sales_quotation';
  92   return $::locale->text('Request quotation') if $type eq 'request_quotation';
  93   return $::locale->text('Sales Order')       if $type eq 'sales_order';
  94   return $::locale->text('Purchase Order')    if $type eq 'purchase_order';
  95
  96   die 'invalid type';
  97 }
  98
  99 sub displayable_name {
 100   join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
 101 };
 102
 103 sub is_sales {
 104   croak 'not an accessor' if @_ > 1;
 105   return !!shift->customer_id;
 106 }
 107
 108 sub invoices {
 109   my $self   = shift;
 110   my %params = @_;
 111
 112   if ($self->quotation) {
 113     return [];
 114   } else {
 115     require SL::DB::Invoice;
 116     return SL::DB::Manager::Invoice->get_all(
 117       query => [
 118         ordnumber => $self->ordnumber,
 119         @{ $params{query} || [] },
 120       ]
 121     );
 122   }
 123 }
 124
 125 sub displayable_state {
 126   my ($self) = @_;
 127
 128   return $self->closed ? $::locale->text('closed') : $::locale->text('open');
 129 }
 130
 131 sub abschlag_invoices {
 132   return shift()->invoices(query => [ abschlag => 1 ]);
 133 }
 134
 135 sub end_invoice {
 136   return shift()->invoices(query => [ abschlag => 0 ]);
 137 }
 138
 139 sub convert_to_invoice {
 140   my ($self, %params) = @_;
 141
 142   croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
 143
 144   my $invoice;
 145   if (!$self->db->with_transaction(sub {
 146     require SL::DB::Invoice;
 147     $invoice = SL::DB::Invoice->new_from($self)->post(%params) || die;
 148     $self->link_to_record($invoice);
 149     $self->update_attributes(closed => 1);
 150     1;
 151   })) {
 152     return undef;
 153   }
 154
 155   return $invoice;
 156 }
 157
 158 sub convert_to_delivery_order {
 159   my ($self, @args) = @_;
 160
 161   my $delivery_order;
 162   if (!$self->db->with_transaction(sub {
 163     require SL::DB::DeliveryOrder;
 164     $delivery_order = SL::DB::DeliveryOrder->new_from($self, @args);
 165     $delivery_order->save;
 166     $self->link_to_record($delivery_order);
 167     # TODO extend link_to_record for items, otherwise long-term no d.r.y.
 168     foreach my $item (@{ $delivery_order->items }) {
 169       foreach (qw(orderitems)) {    # expand if needed (delivery_order_items)
 170         if ($item->{"converted_from_${_}_id"}) {
 171           die unless $item->{id};
 172           RecordLinks->create_links('dbh'        => $self->db->dbh,
 173                                     'mode'       => 'ids',
 174                                     'from_table' => $_,
 175                                     'from_ids'   => $item->{"converted_from_${_}_id"},
 176                                     'to_table'   => 'delivery_order_items',
 177                                     'to_id'      => $item->{id},
 178           ) || die;
 179           delete $item->{"converted_from_${_}_id"};
 180         }
 181       }
 182     }
 183
 184     $self->update_attributes(delivered => 1);
 185     1;
 186   })) {
 187     return undef;
 188   }
 189
 190   return $delivery_order;
 191 }
 192
 193 sub _clone_orderitem_cvar {
 194   my ($cvar) = @_;
 195
 196   my $cloned = $_->clone_and_reset;
 197   $cloned->sub_module('orderitems');
 198
 199   return $cloned;
 200 }
 201
 202 sub new_from {
 203   my ($class, $source, %params) = @_;
 204
 205   croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
 206   croak("A destination type must be given as parameter")         unless $params{destination_type};
 207
 208   my $destination_type  = delete $params{destination_type};
 209
 210   my @from_tos = (
 211     { from => 'sales_quotation',   to => 'sales_order',       abbr => 'sqso' },
 212     { from => 'request_quotation', to => 'purchase_order',    abbr => 'rqpo' },
 213     { from => 'sales_quotation',   to => 'sales_quotation',   abbr => 'sqsq' },
 214     { from => 'sales_order',       to => 'sales_order',       abbr => 'soso' },
 215     { from => 'request_quotation', to => 'request_quotation', abbr => 'rqrq' },
 216     { from => 'purchase_order',    to => 'purchase_order',    abbr => 'popo' },
 217     { from => 'sales_order',       to => 'purchase_order',    abbr => 'sopo' },
 218     { from => 'purchase_order',    to => 'sales_order',       abbr => 'poso' },
 219   );
 220   my $from_to = (grep { $_->{from} eq $source->type && $_->{to} eq $destination_type} @from_tos)[0];
 221   croak("Cannot convert from '" . $source->type . "' to '" . $destination_type . "'") if !$from_to;
 222
 223   my $is_abbr_any = sub {
 224     # foreach my $abbr (@_) {
 225     #   croak "no such abbreviation: '$abbr'" if !grep { $_->{abbr} eq $abbr } @from_tos;
 226     # }
 227     any { $from_to->{abbr} eq $_ } @_;
 228   };
 229
 230   my ($item_parent_id_column, $item_parent_column);
 231
 232   if (ref($source) eq 'SL::DB::Order') {
 233     $item_parent_id_column = 'trans_id';
 234     $item_parent_column    = 'order';
 235   }
 236
 237   my %args = ( map({ ( $_ => $source->$_ ) } qw(amount cp_id currency_id cusordnumber customer_id delivery_customer_id delivery_term_id delivery_vendor_id
 238                                                 department_id employee_id globalproject_id intnotes marge_percent marge_total language_id netamount notes
 239                                                 ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id
 240                                                 transaction_description vendor_id
 241                                              )),
 242                quotation => !!($destination_type =~ m{quotation$}),
 243                closed    => 0,
 244                delivered => 0,
 245                transdate => DateTime->today_local,
 246             );
 247
 248   if ( $is_abbr_any->(qw(sopo poso)) ) {
 249     $args{ordnumber} = undef;
 250     $args{reqdate}   = DateTime->today_local->next_workday();
 251     $args{employee}  = SL::DB::Manager::Employee->current;
 252   }
 253   if ( $is_abbr_any->(qw(sopo)) ) {
 254     $args{customer_id}      = undef;
 255     $args{salesman_id}      = undef;
 256     $args{payment_id}       = undef;
 257     $args{delivery_term_id} = undef;
 258   }
 259   if ( $is_abbr_any->(qw(poso)) ) {
 260     $args{vendor_id} = undef;
 261   }
 262
 263   # Custom shipto addresses (the ones specific to the sales/purchase
 264   # record and not to the customer/vendor) are only linked from
 265   # shipto → order. Meaning order.shipto_id
 266   # will not be filled in that case.
 267   if (!$source->shipto_id && $source->id) {
 268     $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
 269
 270   } else {
 271     $args{shipto_id} = $source->shipto_id;
 272   }
 273
 274   my $order = $class->new(%args);
 275   $order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
 276   my $items = delete($params{items}) || $source->items_sorted;
 277   my %item_parents;
 278
 279   my @items = map {
 280     my $source_item      = $_;
 281     my $source_item_id   = $_->$item_parent_id_column;
 282     my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
 283
 284     $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
 285     my $item_parent                  = $item_parents{$source_item_id};
 286
 287     my $current_oe_item = SL::DB::OrderItem->new(map({ ( $_ => $source_item->$_ ) }
 288                                                      qw(active_discount_source active_price_source base_qty cusordnumber
 289                                                         description discount lastcost longdescription
 290                                                         marge_percent marge_price_factor marge_total
 291                                                         ordnumber parts_id price_factor price_factor_id pricegroup_id
 292                                                         project_id qty reqdate sellprice serialnumber ship subtotal transdate unit
 293                                                      )),
 294                                                  custom_variables => \@custom_variables,
 295     );
 296     if ( $is_abbr_any->(qw(sopo)) ) {
 297       $current_oe_item->sellprice($source_item->lastcost);
 298       $current_oe_item->discount(0);
 299     }
 300     if ( $is_abbr_any->(qw(poso)) ) {
 301       $current_oe_item->lastcost($source_item->sellprice);
 302     }
 303     $current_oe_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
 304     $current_oe_item;
 305   } @{ $items };
 306
 307   @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
 308   @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
 309   @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
 310
 311   $order->items(\@items);
 312
 313   return $order;
 314 }
 315
 316 sub number {
 317   my $self = shift;
 318
 319   return if !$self->type;
 320
 321   my %number_method = (
 322     sales_order       => 'ordnumber',
 323     sales_quotation   => 'quonumber',
 324     purchase_order    => 'ordnumber',
 325     request_quotation => 'quonumber',
 326   );
 327
 328   return $self->${ \ $number_method{$self->type} }(@_);
 329 }
 330
 331 sub customervendor {
 332   $_[0]->is_sales ? $_[0]->customer : $_[0]->vendor;
 333 }
 334
 335 sub date {
 336   goto &transdate;
 337 }
 338
 339 sub digest {
 340   my ($self) = @_;
 341
 342   sprintf "%s %s %s (%s)",
 343     $self->number,
 344     $self->customervendor->name,
 345     $self->amount_as_number,
 346     $self->date->to_kivitendo;
 347 }
 348
 349 1;
 350
 351 __END__
 352
 353 =pod
 354
 355 =encoding utf8
 356
 357 =head1 NAME
 358
 359 SL::DB::Order - Order Datenbank Objekt.
 360
 361 =head1 FUNCTIONS
 362
 363 =head2 C<type>
 364
 365 Returns one of the following string types:
 366
 367 =over 4
 368
 369 =item sales_order
 370
 371 =item purchase_order
 372
 373 =item sales_quotation
 374
 375 =item request_quotation
 376
 377 =back
 378
 379 =head2 C<is_type TYPE>
 380
 381 Returns true if the order is of the given type.
 382
 383 =head2 C<convert_to_delivery_order %params>
 384
 385 Creates a new delivery order with C<$self> as the basis by calling
 386 L<SL::DB::DeliveryOrder::new_from>. That delivery order is saved, and
 387 C<$self> is linked to the new invoice via
 388 L<SL::DB::RecordLink>. C<$self>'s C<delivered> attribute is set to
 389 C<true>, and C<$self> is saved.
 390
 391 The arguments in C<%params> are passed to
 392 L<SL::DB::DeliveryOrder::new_from>.
 393
 394 Returns C<undef> on failure. Otherwise the new delivery order will be
 395 returned.
 396
 397 =head2 C<convert_to_invoice %params>
 398
 399 Creates a new invoice with C<$self> as the basis by calling
 400 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
 401 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
 402 C<closed> attribute is set to C<true>, and C<$self> is saved.
 403
 404 The arguments in C<%params> are passed to L<SL::DB::Invoice::post>.
 405
 406 Returns the new invoice instance on success and C<undef> on
 407 failure. The whole process is run inside a transaction. On failure
 408 nothing is created or changed in the database.
 409
 410 At the moment only sales quotations and sales orders can be converted.
 411
 412 =head2 C<new_from $source, %params>
 413
 414 Creates a new C<SL::DB::Order> instance and copies as much
 415 information from C<$source> as possible. At the moment only records with the
 416 same destination type as the source type and sales orders from
 417 sales quotations and purchase orders from requests for quotations can be
 418 created.
 419
 420 The C<transdate> field will be set to the current date.
 421
 422 The conversion copies the order items as well.
 423
 424 Returns the new order instance. The object returned is not
 425 saved.
 426
 427 C<%params> can include the following options
 428 (C<destination_type> is mandatory):
 429
 430 =over 4
 431
 432 =item C<destination_type>
 433
 434 (mandatory)
 435 The type of the newly created object. Can be C<sales_quotation>,
 436 C<sales_order>, C<purchase_quotation> or C<purchase_order> for now.
 437
 438 =item C<items>
 439
 440 An optional array reference of RDBO instances for the items to use. If
 441 missing then the method C<items_sorted> will be called on
 442 C<$source>. This option can be used to override the sorting, to
 443 exclude certain positions or to add additional ones.
 444
 445 =item C<skip_items_negative_qty>
 446
 447 If trueish then items with a negative quantity are skipped. Items with
 448 a quantity of 0 are not affected by this option.
 449
 450 =item C<skip_items_zero_qty>
 451
 452 If trueish then items with a quantity of 0 are skipped.
 453
 454 =item C<item_filter>
 455
 456 An optional code reference that is called for each item with the item
 457 as its sole parameter. Items for which the code reference returns a
 458 falsish value will be skipped.
 459
 460 =item C<attributes>
 461
 462 An optional hash reference. If it exists then it is passed to C<new>
 463 allowing the caller to set certain attributes for the new delivery
 464 order.
 465
 466 =back
 467
 468 =head2 C<create_sales_process>
 469
 470 Creates and saves a new sales process. Can only be called for sales
 471 orders.
 472
 473 The newly created process will be linked bidirectionally to both
 474 C<$self> and to all sales quotations that are linked to C<$self>.
 475
 476 Returns the newly created process instance.
 477
 478 =head1 BUGS
 479
 480 Nothing here yet.
 481
 482 =head1 AUTHOR
 483
 484 Sven Schöling <s.schoeling@linet-services.de>
 485
 486 =cut